1. Only one instance is allowed to start the program.
VaR
Mutex: thandle;
Begin
Mutex: = createmutex (nil, true, '80a8a422-D84F-4FEA-953F-B08148F60ABD ');
If getlasterror <> error_already_exists then
Begin
Application. initialize;
Application. createform (tfmmonitor, fmmonitor );
Application. Run;
End else
Begin
Releasemutex (mutex );
End;
2. Write logs
Procedure writelog (STR: string );
VaR
F: textfile;
Strfile: string;
Begin
Strfile: = apppath + 'dataex. log ';
{I -}
Assignfile (F, strfile );
If fileexists (strfile) then
Begin
If filesizebyname (strfile)> 1024*50 then
Rewrite (f );
End else
Rewrite (f );
Append (f );
Writeln (F, STR );
Writeln (F ,'');
Closefile (f );
{I +}
End;
3. Minimal after starting the program
Procedure tfmmonitor. formshow (Sender: tobject );
Begin
Postmessage (handle, wm_syscommand, SC _minimize, 0 );
End;
4. multi-thread synchronization
Thread call:
Hmutex: = createmutex (nil, false, nil );
Ftpdothread: = tftpthread. Create (true );
Ftpdothread. Resume;
Thread definition:
Type
Tftpthread = Class (tthread)
Private
Protected
Procedure execute; override;
Destructor destroy; override;
End;
VaR
Ftpdothread: tftpthread;
Hmutex: thandle = 0;
Implementation
Destructor tftpthread. Destroy;
Begin
Ftpdothread: = nil;
Inherited;
End;
Procedure tftpthread. Execute;
Begin
Freeonterminate: = true;
If waitforsingleobject (hmutex, infinite) = wait_object_0 then
Begin
.........
End;
Releasemutex (hmutex );
Terminate;
End;
5. Create a directory
Procedure tfmmonitor. testcreatedir (instr: string );
Begin
If not directoryexists (apppath + instr) then
Begin
{$ I -}
Createdir (apppath + instr );
{$ I +}
End;
End;
6. Get a directory file (excluding subdirectories)
Call: getdirfiles (fmmonitor. apppath + 'upload /*.*');
Function tftpthread. getdirfiles (indirstr: string): tstrings;
VaR
Ifindresult: integer;
Searchrec: tsearchrec;
Filelist: tstrings;
Begin
Filelist: = tstringlist. Create;
Ifindresult: = findfirst (indirstr, faanyfile, searchrec );
While ifindresult = 0 do
Begin
If searchrec. ATTR <> fadirectory then
Filelist. Add (searchrec. Name );
Ifindresult: = findnext (searchrec );
End;
Findclose (searchrec );
Result: = filelist;
End;
7. Replace and repeat Functions
Ansireplacestr
Dupestring
8. prevent screen refreshing
Lockwindowupdate (getmediatopwindow );
Lockwindowupdate (handle );
........
Lockwindowupdate (0 );
9. Execute external programs
ShellExecute (handle, 'open', pchar (extractfilepath (application. exename)
+ 'Readme. chm'), nil, nil, sw_shownormal)
10. shotcut usage of the tapplicationevent component
Procedure tdemoform. apppresskeyshortcut (var msg: twmkey;
VaR handled: Boolean );
Begin
Case msg. charcode
Vk_f7:
Begin
End;
End;
End;
11. Hide the mouse
Showcursor (false );
12. Only uppercase letters are allowed.
Keypress (Sender: tobject; var key: Char );
Begin
If ord (key) in [97 .. 122] Then
Key: = CHR (ord (key)-32 );
End;