Witam,
Mam pewien problem.... mianowicie chodzi mi o usluge ktora w pewnym odstepie czasu robi zrzut ekranu mojego komputera (pewnie pomyslicie ze to trojan... zapewniam ze nie)... ale podejzewam ze ktos mi podgladuje komputer... i mam problem :| juz rozmawialem z ludzi odnosnie spyware, malware.... komputer jest oczyszczony bez virusow i innych... a problem nadal wystepuje.... inna rzecz ktora probowalem to przerobilem usluge na zwykla aplikacje z mysla ze to calkowicie rozwiaze problem... a jednak nie :|
oto jak wyglada blad w dzienniku zdarzen:
Aplikacja powodująca błąd testowa.exe, wersja 0.0.0.0, moduł powodujący błąd kernel32.dll, wersja 5.1.2600.3119, adres błędu 0x00012a5b.
Przetwarzanie zdarzenia określonego nośnika dla [testowa.exe!ws!]
Kod aplikacji (jest latwiejszy od uslugi, problem jest ten sam wiec i rozwiazanie musi byc tu):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IBDatabase, DB, IBCustomDataSet, IBStoredProc, ExtCtrls, jpeg,
TlHelp32;
type
TForm1 = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
Timer4: TTimer;
IBDatabase1: TIBDatabase;
IBStoredProc1: TIBStoredProc;
IBTransaction1: TIBTransaction;
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Hook:Integer;
MessageBuffer:TEventMsg;
Data, Czas, Sciezka: String;
MainHook : HHOOK;
lpWnd : PChar;
implementation
{$R *.dfm}
function Nazwa: String;
var
Buffer: array[0..255] of char;
Size: DWORD;
begin
Size := 256;
GetComputerName(Buffer, Size);
Result := Buffer;
end;
FUNCTION ProcessName(pid: Integer):String;
var
uchwyt :THandle;
proces :TProcessEntry32;
Begin
Result:= '';
uchwyt:= CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
proces.dwSize:= SizeOf(Proces);
if Integer(Process32First(uchwyt, proces)) <> 0 then
repeat
if pid = proces.th32ProcessID then Result:= proces.szExeFile;
until Integer(Process32Next(uchwyt, proces)) = 0;
CloseHandle(uchwyt);
End;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Can: TCanvas;
Bit: TBitmap;
JPEG: TJPEGImage;
SS: TStringStream;
Rozd : packed record
X, Y : Integer;
end;
begin
Timer1.Enabled := False;
try
if IBDataBase1.Connected = False then
IBDataBase1.Connected := True;
if IBDataBase1.Connected then
begin
Can := TCanvas.Create;
Can.Handle := GetWindowDC(GetDesktopWindow);
Bit := TBitmap.Create;
Rozd.X := GetSystemMetrics(SM_CXSCREEN);
Rozd.Y := GetSystemMetrics(SM_CYSCREEN);
Bit.Width := Rozd.X;
Bit.Height := Rozd.Y;
Bit.Canvas.CopyRect(Rect(0, 0, Rozd.X, Rozd.Y),
Can,
Rect(0, 0, Rozd.X, Rozd.Y));
JPEG := TJPEGImage.Create;
JPEG.CompressionQuality:=100;
JPEG.Assign(Bit);
Data := DateToStr(Date);
Czas := TimeToStr(Time);
SS := TStringStream.Create('');
JPEG.SaveToStream(SS);
IBStoredProc1.StoredProcName := 'DOD_OBR';
IBStoredProc1.ParamByName('OBRAZEK').AsBlob := SS.DataString;
IBStoredProc1.ParamByName('KOMP').AsString := Nazwa;
IBStoredProc1.ParamByName('DATA').AsString := Data;
IBStoredProc1.ParamByName('CZAS').AsString := Czas;
IBStoredProc1.ExecProc;
IBTransaction1.Commit;
SS.Free;
Can.Free;
JPEG.Free;
Bit.Free;
end;
Timer1.Enabled := True;
except
Timer1.Enabled := True;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if IBDatabase1.Connected = False then
begin
Timer4.Enabled := False;
Timer1.Enabled := False;
repeat
try
IBDatabase1.Connected := True;
except
end;
Sleep(3000);
until IBDatabase1.Connected;
Timer1.Enabled := True;
Timer4.Enabled := True;
end;
end;
procedure TForm1.Timer4Timer(Sender: TObject);
begin
if Timer1.Enabled = False then Timer1.Enabled := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled := True;
Timer2.Enabled := True;
Timer4.Enabled := True;
end;
end.