1. 可以使用TELTimerPool來一次新增多個Timer,並方便管理
2. 預設為Timer.Enabled := False; 於onFormShow再將Timer.Enabled := True;
3. 為避免onTimer內程式跑沒完,下個時間的觸發又到,可加旗標來防止下個時間的進入。
4. 可以設定第一次跑15秒後跑,之後是1分半後跑一次,則預設Timer.Interval:=15000。然後在onTimer的程式內寫Timer.Interval:=90000
5. Timer的第一次觸發是inteval時間完後才跑。
星期三, 9月 19, 2012
TStringList的AddObject使用方式
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
PMyRec = ^TMyrec;
TMyRec = record
s: string;
i: Integer;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
List: TStringList;
R1,R2: TMyRec;
str: string;
i: Integer;
begin
List := TStringList.Create;
R1.s := 'abc';
R1.i := 123;
str := '我是字符串';
List.AddObject('1', @R1); {用 1 表示结构 TMyRec}
List.AddObject('2', Sender); {用 2 表示 TButton}
List.AddObject('3', Self); {用 3 表示 TForm1}
List.AddObject('4', Pointer(str)); {用 4 表示 String}
for i := 0 to List.Count - 1 do
begin
case StrToIntDef(List[i], 0) of
1: begin
R2 := PMyRec(List.Objects[i])^;
ShowMessageFmt('%s,%d', [R2.s, R2.i]); {abc,123}
end;
2: ShowMessage(TButton(List.Objects[i]).Caption); {Button1}
3: ShowMessage(TForm1(List.Objects[i]).Text); {Form1}
4: ShowMessage(PChar(List.Objects[i])); {我是字符串}
end;
end;
List.Free;
end;
end.
字串還是要用record的方式
type
TStringRec = record
s: string;
end;
PStringRec = ^TStringrec;
implementation
{$R *.dfm}
procedure AddAllFetchParamList(AllFetchParamList1: TStringList; sFinalDate1, sNo1:string);
var
FindIndex : integer;
sRec : PStringRec;
tmpStr : string;
begin
FindIndex := AllFetchParamList1.IndexOf(sFinalDate1);
if FindIndex>=0 then //表示有找到
begin
tmpStr := PStringRec(AllFetchParamList1.Objects[FindIndex])^.s+','+sNo1;
PStringRec(AllFetchParamList1.Objects[FindIndex])^.s := tmpStr;
end else begin
new(sRec);
sRec.s := sNo1;
AllFetchParamList1.AddObject(sFinalDate1, TObject(sRec));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sl: TStringList;
i: integer;
begin
sl:= TStringList.Create;
try
AddAllFetchParamList(sl, '2011/01/01', '1');
AddAllFetchParamList(sl, '2011/01/01', '2');
AddAllFetchParamList(sl, '2011/03/01', '3');
AddAllFetchParamList(sl, '2011/01/01', '4');
AddAllFetchParamList(sl, '2011/03/01', '5');
finally
for i := 0 to sl.Count-1 do
Dispose(PStringRec(sl.Objects[i]));
sl.Free;
end;
end;
TStringList可以以特定字元做分割及排除空白即分割的情況
var
ASource: PChar;
AStr: String;
astr1: string;
ACount,i: Integer;
AStrings: TStringList;
begin
ASource := 'WorkerW||tooltips_class32||NotifyWnd||MSCTFIME UI||IME||ComboLBox||Auto-Suggest Dropdown||ATL:00409BA8||#43||';
AStrings := TStringList.Create;
Memo1.Clear;
try
ACount := ExtractStrings(['|'], [' ','#','.'], ASource, AStrings);
For i:=0 to ACount-1 do
begin
Memo1.Lines.Add(AStrings[i]);
end;
星期二, 9月 18, 2012
判斷磁碟空間是否小於40M
procedure TForm1.Button1Click(Sender: TObject);
var
btWorkDrive: Byte;
DiskFreeSize: Int64;
begin
//硬碟空間不夠,小於5m則跳出不存囉
btWorkDrive := Ord(UpperCase('C:\test\')[1])-64; //g_sTempPath
DiskFreeSize := DiskFree(btWorkDrive);
if (DiskFreeSize<>-1) and ((DiskFreeSize div (1024*1024)){MB}<40) then
Exit;
end;
星期五, 9月 07, 2012
取得AllUserAppData及LocalAppData的目錄
uses SHFolder; const _BUFSZ = 516; var buf: array[0.. _BUFSZ-1] of Char; begin FillChar(buf[0], _BUFSZ, 0); SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, 0, @buf[0]); g_sLocalAppData := buf; FillChar(buf[0], _BUFSZ, 0); SHGetFolderPath(0, CSIDL_COMMON_APPDATA, 0, 0, @buf[0]); g_sAllUserAppData := buf; sUserCfg := g_sLocalAppData+'\Microsoft\'; end;
星期二, 9月 04, 2012
取得檔案的修改時間
function GetFileAltertTime(FileName: string): string;
begin
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', FileDateToDateTime(FileAge(FileName)));
end;
procedure TForm8.Button1Click(Sender: TObject);
begin
caption := GetFileAltertTime('C:\Source\1.exe');
end;
判斷作業系統是否為Windows XP SP2+
//判斷作業系統是否為Windows XP SP2+
function IsXPSP2Above():boolean ;
var
vi: _OSVERSIONINFO;
begin
Result:=False;
FillChar(vi, SizeOf(vi), 0);
vi.dwOSVersionInfoSize := SizeOf(vi);
Windows.GetVersionEx(vi);
// 作業系統
if (vi.dwMajorVersion=5) and (vi.dwMinorVersion = 1) and (Pos('Service Pack 2', AnsiString(vi.szCSDVersion)) > 0) then Result:=True //Windows XP SP2
else if (vi.dwMajorVersion=5) and (vi.dwMinorVersion = 1) and (Pos('Service Pack 3', AnsiString(vi.szCSDVersion)) > 0) then Result:=True //Windows XP SP3
else if (vi.dwMajorVersion=5) and (vi.dwMinorVersion = 2) then Result:=True //Microsoft Windows Server 2003, Windows XP 64
//(vi.dwMajorVersion=5) and (vi.dwMinorVersion = 0) Microsoft Windows 2000
else if (vi.dwMajorVersion>5) then Result:=True; //Vista+
end;
判斷是否有安裝Access趨動
uses Registry;
function IsInstallAccessDatabaseEngine: boolean;
var
reg: TRegistry;
begin
Result := False;
reg:=TRegistry.Create;
try
reg.RootKey:=HKEY_LOCAL_MACHINE;
if (Reg.OpenKeyReadOnly('SOFTWARE\Classes\Microsoft.ACE.OLEDB.12.0')) or
(Reg.OpenKeyReadOnly('SOFTWARE\Wow6432Node\Classes\Microsoft.ACE.OLEDB.12.0')) then
Result := True;
finally
reg.CloseKey;
reg.Free;
end;
end;
星期一, 9月 03, 2012
取得固定硬碟的序號
procedure TForm1.Button1Click(Sender: TObject);
var
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
TheSerialNumber : String;
DR: Char;
RootPath: PChar;
begin
for DR := 'C' To 'Z' Do
begin
RootPath := PChar(DR + ':\');
if (GetDriveType(RootPath) = DRIVE_FIXED) Then
begin
if GetVolumeInformation(RootPath,nil,0,@VolumeSerialNumber,
MaximumComponentLength,FileSystemFlags,nil,0) then
begin
TheSerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) +
IntToHex(LoWord(VolumeSerialNumber), 4);
end;
memo1.Clear;
memo1.Lines.Add( Format('固定磁碟序號:%s',[TheSerialNumber]) );
end;
end;
end;
訂閱:
意見 (Atom)