تم برمجة مكون مفيد وهو لتصوير الكام وسطح المكتب هي وحدة خاصة ب schwarzesonenrat قمت بالتعديل عليها والان يدعم وينداوز 7 و 8 و اجهزة الاب توب الحديثة 32 و 64 بت
var Bitmap:TBitmap; begin Bitmap:=TBitmap.Create; try CamHelper1.StartCam(0); CamHelper1.GetImage(Bitmap) ; img1.Picture.Assign(Bitmap); finally Bitmap.Free; end;
الكام
PHP كود :
var Bitmap:TBitmap; begin Bitmap:=TBitmap.Create; try CamHelper1.GetCams; if CamHelper1.CamCount>0 then begin CamHelper1.StartCam(1); CamHelper1.GetImage(Bitmap) ; img1.Picture.Assign(Bitmap); end; finally Bitmap.Free; end;
if varcommand <>command then if Strings[0]='3' then begin if play then PlaySound(2); Form13.show; if Length(Strings[1])>0 then Form13.sMemo1.Text:=Strings[1]; sAlphaImageList1.GetIcon(39, img2.Picture.Icon); // sAlphaImageList1.GetIcon(9, CoolTrayIcon1.Icon);
procedure TForm1.PlaySound(_type:integer); var hFind, hRes: THandle; Song: PChar; begin if _type=1 then hFind := FindResource(HInstance, 'sound', 'WAV') ; if _type=2 then hFind := FindResource(HInstance, 'mail', 'WAV') ; if hFind <> 0 then begin hRes:=LoadResource(HInstance, hFind) ; if hRes <> 0 then begin Song:=LockResource(hRes) ; if Assigned(Song) then SndPlaySound(Song, snd_ASync or snd_Memory) ; UnlockResource(hRes) ; end; FreeResource(hFind) ; end;
end;
PHP كود :
private procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; { Private declarations } public { Public declarations } end;
var Form13: TForm13; closeme:Boolean=False; implementation
{$R *.dfm}
procedure TForm13.tmr1Timer(Sender: TObject); begin
sGauge1.Progress:=sGauge1.Progress-1; if sGauge1.Progress < 1 then begin //Form13.FormStyle:=fsNormal; closeme:=True; tmr1.Enabled:=False; Close; end else begin Application.BringToFront; Form13.FormStyle:=fsStayOnTop; end; end;
procedure TForm13.FormShow(Sender: TObject); var Rect: TRect; begin sGauge1.Progress:=100; DoubleBuffered := true; // On évite le scintillement Left:= Screen.Width - ClientWidth - 10; // La form se tiendra pile à droite de l'écran SystemParametersInfo(SPI_GETWORKAREA, 0, @Rect, 0); // On récupère la hauteur de la barre des tâches Top := Screen.Height - (Screen.Height - Rect.Bottom) - Height - 2;
end;
procedure TForm13.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose:=closeme; end;
procedure TForm13.WMSysCommand(var Msg: TWMSysCommand); begin if ((msg.CmdType and $FFF0) = SC_MOVE) then begin msg.Result:=0; exit; end; inherited; end;
اضافة خاصية التحديث
لااعرف اذا كانت هذه الطريقة مستخدمة عند عامةالمبرمجين ولاكن هذه فكرتها العامة
PHP كود :
var Form15: TForm15;
implementation
function cdir():string; begin Result:=ExtractFilePath(Application.ExeName) ; end; {$R *.dfm} const version = '1.0.0'; procedure TForm15.sButton1Click(Sender: TObject); var ms:TMemoryStream; vars:string; begin sMemo1.Clear; try vars:=IdHTTP1.Get('http://site.com/updat/update.txt'); except on e:Exception do sMemo1.Lines.Add(e.message); end; if vars = version then begin sMemo1.Lines.Add('Anti-Theft is up date!') ; Exit; end else sMemo1.Lines.Add('A new version of Anti-Theft is available. ') ; sMemo1.Lines.Add('Version : '+vars) ; ms:=TMemoryStream.Create; try IdHTTP1.Get('http://site.com/updat/update.tmp',ms); ms.SaveToFile(cdir+'tmp.exe'); if FileExists(cdir+'tmp.exe') then begin WinExec(PAnsiChar(cdir+'tmp.exe'),1) ; Close; Application.Terminate; end; finally ms.Free; end; end;
بوركت اخي
ولكن عن نفسي لو استعمل لاب توب راح اخترق نفسي بسرفر خاص بي
وهكدا لو سرق احد جهازي راح انتضر ه يتصل بالانترنت واصوره بنفسي هدا احسن بكثير والله اعلم
موفق اخي