我收集與整理的一些Delphi函式
{*******************************************************}
{ }
{ Delphi公用函式單元 }
{ }
{ 版權所有 (C) 2008 勇者工作室 }
{ }
{*******************************************************}
unit YzDelphiFunc;
interface
uses
ComCtrls, Forms, Windows, Classes, SysUtils, ComObj, ActiveX, ShlObj, Messages,
Graphics, Registry, Dialogs, Controls, uProcess, uCpuUsage, StrUtils, CommCtrl,
jpeg, WinInet, ShellAPI, SHFolder, ADODB, WinSock;
{ 儲存日誌檔案 }
procedure YzWriteLogFile(Msg: String);
{ 延時函式,單位為毫秒 }
procedure YzDelayTime(MSecs: Longint);
{ 判斷字串是否為數字 }
function YzStrIsNum(Str: string):boolean;
{ 判斷檔案是否正在使用 }
function YzIsFileInUse(fName: string): boolean;
{ 刪除字串列表中的空字串 }
procedure YzDelEmptyChar(AList: TStringList);
{ 刪除檔案列表中的"Thumbs.db"檔案 }
procedure YzDelThumbsFile(AList: TStrings);
{ 返回一個整數指定位數的帶"0"字串 }
function YzIntToZeroStr(Value, ALength: Integer): string;
{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;
{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;
{ 取日期天數分量 }
function YzGetDay(Date: TDate): Integer;
{ 取時間小時分量 }
function YzGetHour(Time: TTime): Integer;
{ 取時間分鐘分量 }
function YzGetMinute(Time: TTime): Integer;
{ 取時間秒鐘分量 }
function YzGetSecond(Time: TTime): Integer;
{ 返回時間分量字串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;
{ 返回日期時間字串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
{ 獲取計算機名稱 }
function YzGetComputerName(): string;
{ 通過窗體子串查詢窗體 }
procedure YzFindSpecWindow(ASubTitle: string);
{ 判斷程序CPU佔用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
{ 分割字串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
{ 切換頁面控制元件的活動頁面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
{ 設定頁面控制元件標籤的可見性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
{ 根據產品名稱獲取產品編號 }
function YzGetLevelCode(AName:string;ProductList: TStringList): string;
{ 取檔案的主檔名 }
function YzGetMainFileName(AFileName: string): string;
{ 按下一個鍵 }
procedure YzPressOneKey(AByteCode: Byte);overload;
{ 按下一個指定次數的鍵 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
{ 按下二個鍵 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
{ 按下三個鍵 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
{ 建立桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
{ 刪除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);
{ 通過游標位置進行滑鼠左鍵單擊 }
procedure YzMouseLeftClick(X, Y: Integer);overload;
{ 滑鼠左鍵雙擊 }
procedure YzMouseDoubleClick(X, Y: Integer);
{ 通過視窗控制代碼進行滑鼠左鍵單擊 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
{ 通過游標位置查詢視窗控制代碼 }
function YzWindowFromPoint(X, Y: Integer): THandle;
{ 等待視窗在指定時間後出現 }
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
ASecond: Integer = 0): THandle;overload;
{ 通游標位置,視窗類名與標題查詢視窗是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
ASecond: Integer = 0):THandle; overload;
{ 等待指定視窗消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
ASecond: Integer = 0);
{ 通過視窗控制代碼設定文字框控制元件文字 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
AText: string);overload;
{ 通過游標位置設定文字框控制元件文字 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;
{ 獲取Window作業系統語言 }
function YzGetWindowsLanguageStr: String;
{ 清空動態陣列 }
procedure YzDynArraySetZero(var A);
{ 動態設定螢幕解析度 }
function YzDynamicResolution(X, Y: WORD): Boolean;
{ 檢測系統螢幕解析度 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;
type
TFontedControl = class(TControl)
public
property Font;
end;
TFontMapping = record
SWidth : Integer;
SHeight: Integer;
FName: string;
FSize: Integer;
end;
procedure YzFixForm(AForm: TForm);
procedure YzSetFontMapping;
{---------------------------------------------------
以下是關於獲取系統軟體解除安裝的資訊的型別宣告和函式
----------------------------------------------------}
type
TUninstallInfo = array of record
RegProgramName: string;
ProgramName : string;
UninstallPath : string;
Publisher : string;
PublisherURL : string;
Version : string;
HelpLink : string;
UpdateInfoURL : string;
RegCompany : string;
RegOwner : string;
end;
{ GetUninstallInfo 返回系統軟體解除安裝的資訊 }
function YzGetUninstallInfo : TUninstallInfo;
{ 檢測Java安裝資訊 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
{ 視窗自適應螢幕大小 }
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
{ 設定視窗為當前窗體 }
procedure YzBringMyAppToFront(AppHandle: THandle);
{ 獲取資料夾大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
{ 獲取資料夾檔案數量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
{ 獲取檔案大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;
{ 獲取檔案大小(位元組) }
function YzGetFileSize_Byte(const FileName: String): LongInt;
{ 算術舍入法的四捨五入取整函式 }
function YzRoundEx (const Value: Real): LongInt;
{ 彈出選擇目錄對話方塊 }
function YzSelectDir(const iMode: integer;const sInfo: string): string;
{ 獲取指定路徑下資料夾的個數 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
{ 禁用窗器控制元件的所有子控制元件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
{ 模擬鍵盤按鍵操作(處理位元組碼) }
procedure YzFKeyent(byteCard: byte); overload;
{ 模擬鍵盤按鍵操作(處理字串 }
procedure YzFKeyent(strCard: string); overload;
{ 鎖定視窗位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
{ 註冊一個DLL形式或OCX形式的OLE/COM控制元件
引數strOleFileName為一個DLL或OCX檔名，
引數OleAction表示註冊操作型別，1表示註冊，0表示解除安裝
返回值True表示操作執行成功，False表示操作執行失敗
}
function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
function YzListViewColumnCount(mHandle: THandle): Integer;
function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
{ 刪除目錄樹 }
function YzDeleteDirectoryTree(Path: string): boolean;
{ Jpg格式轉換為bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;
{ 設定程式自啟動函式 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
{ 檢測URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;
{ 獲取程式可執行檔名 }
function YzGetExeFName: string;
{ 目錄瀏覽對話方塊函式 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
{ 重啟計算機 }
function YzShutDownSystem(AFlag: Integer):BOOL;
{ 程式執行後刪除自身 }
procedure YzDeleteSelf;
{ 程式重啟 }
procedure YzAppRestart;
{ 壓縮Access資料庫 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
{ 標題:獲取其他程序中TreeView的文字 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
{ 獲取本地Application Data目錄路徑 }
function YzLocalAppDataPath : string;
{ 獲取Windows當前登入的使用者名稱 }
function YzGetWindwosUserName: String;
{列舉托盤圖示 }
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
{ 獲取SQL Server使用者資料庫列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
{ 讀取據庫中所有的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
{ 將域名解釋成IP地址 }
function YzDomainToIP(HostName: string): string;
{ 等待程序結束 }
procedure YzWaitProcessExit(AProcessName: string);
{ 移去系統托盤失效圖示 }
procedure YzRemoveDeadIcons();
{ 轉移程式佔用記憶體至虛擬記憶體 }
procedure YzClearMemory;
{ 檢測允許試用的天數是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;
{ 指定長度的隨機小寫字串函式 }
function YzRandomStr(aLength: Longint): string;
var
FontMapping : array of TFontMapping;
implementation
uses
uMain;
{ 儲存日誌檔案 }
procedure YzWriteLogFile(Msg: String);
var
FileStream: TFileStream;
LogFile : String;
begin
try
{ 每天一個日誌檔案 }
Msg := '[' + DateTimeToStr(Now)+ '] '+ Msg;
LogFile := ExtractFilePath(Application.ExeName) + '/Logs/' + DateToStr(Now) + '.log';
if not DirectoryExists(ExtractFilePath(LogFile)) then
CreateDir(ExtractFilePath(LogFile));
if FileExists(LogFile) then
FileStream := TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyNone)
else
FileStream:=TFileStream.Create(LogFile,fmCreate or fmShareDenyNone);
FileStream.Position:=FileStream.Size;
Msg := Msg + #13#10;
FileStream.Write(PChar(Msg)^, Length(Msg));
FileStream.Free;
except
end;
end;
{ 延時函式,單位為毫秒 }
procedure YZDelayTime(MSecs: Longint);
var
FirstTickCount, Now: Longint;
begin
FirstTickCount := GetTickCount();
repeat
Application.ProcessMessages;
Now := GetTickCount();
until (Now - FirstTickCount>=MSecs) or (Now < FirstTickCount);
end;
{ 判斷字串是否為數字 }
function YzStrIsNum(Str: string):boolean;
var
I: integer;
begin
if Str = '' then
begin
Result := False;
Exit;
end;
for I:=1 to length(str) do
if not (Str[I] in ['0'..'9']) then
begin
Result := False;
Exit;
end;
Result := True;
end;
{ 判斷檔案是否正在使用 }
function YzIsFileInUse(fName: string): boolean;
var
HFileRes: HFILE;
begin
Result := false;
if not FileExists(fName) then exit;
HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then CloseHandle(HFileRes);
end;
{ 刪除字串列表中的空字串 }
procedure YzDelEmptyChar(AList: TStringList);
var
I: Integer;
TmpList: TStringList;
begin
TmpList := TStringList.Create;
for I := 0 to AList.Count - 1 do
if AList.Strings[I] <> '' then TmpList.Add(AList.Strings[I]);
AList.Clear;
AList.Text := TmpList.Text;
TmpList.Free;
end;
{ 刪除檔案列表中的"Thumbs.db"檔案 }
procedure YzDelThumbsFile(AList: TStrings);
var
I: Integer;
TmpList: TStringList;
begin
TmpList := TStringList.Create;
for I := 0 to AList.Count - 1 do
if ExtractFileName(AList.Strings[I]) <> 'Thumbs.db' then
TmpList.Add(AList.Strings[I]);
AList.Clear;
AList.Text := TmpList.Text;
TmpList.Free;
end;
{-------------------------------------------------------------
功能: 返回一個整數指定位數的帶"0"字串
引數: Value:要轉換的整數 ALength:字串長度
返回值: string
--------------------------------------------------------------}
function YzIntToZeroStr(Value, ALength: Integer): string;
var
I, ACount: Integer;
begin
Result := '';
ACount := Length(IntToStr(Value));
if ACount >= ALength then Result := IntToStr(Value)
else
begin
for I := 1 to ALength-ACount do
Result := Result + '0';
Result := Result + IntToStr(Value)
end;
end;
{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;
var
y, m, d: WORD;
begin
DecodeDate(Date, y, m, d);
Result := y;
end;
{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;
var
y, m, d: WORD;
begin
DecodeDate(Date, y, m, d);
Result := m;
end;
{ 取日期天數分量 }
function YzGetDay(Date: TDate): Integer;
var
y, m, d: WORD;
begin
DecodeDate(Date, y, m, d);
Result := d;
end;
{ 取時間小時分量 }
function YzGetHour(Time: TTime): Integer;
var
h, m, s, ms: WORD;
begin
DecodeTime(Time, h, m, s, ms);
Result := h;
end;
{ 取時間分鐘分量 }
function YzGetMinute(Time: TTime): Integer;
var
h, m, s, ms: WORD;
begin
DecodeTime(Time, h, m, s, ms);
Result := m;
end;
{ 取時間秒鐘分量 }
function YzGetSecond(Time: TTime): Integer;
var
h, m, s, ms: WORD;
begin
DecodeTime(Time, h, m, s, ms);
Result := s;
end;
{ 返回時間分量字串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;
var
wTimeStr: string;
FH, FM, FS, FMS: WORD;
const
HOURTYPE = 'Hour';
MINUTETYPE = 'Minute';
SECONDTYPE = 'Second';
MSECONDTYPE = 'MSecond';
begin
wTimeStr := TimeToStr(ATime);
if Pos('上午', wTimeStr) <> 0 then
wTimeStr := Copy(wTimeStr, Pos('上午', wTimeStr) + 4, 10)
else if Pos('下午', wTimeStr) <> 0 then
wTimeStr := Copy(wTimeStr, Pos('下午', wTimeStr) + 4, 10);
DecodeTime(ATime, FH, FM, FS, FMS);
if AFlag = HOURTYPE then
begin
{ 如果是12小時制則下午的小時分量加12 }
if Pos('下午', wTimeStr) <> 0 then
Result := YzIntToZeroStr(FH + 12, 2)
else
Result := YzIntToZeroStr(FH, 2);
end;
if AFlag = MINUTETYPE then Result := YzIntToZeroStr(FM, 2);
if AFlag = SECONDTYPE then Result := YzIntToZeroStr(FS, 2);
if AFlag = MSECONDTYPE then Result := YzIntToZeroStr(FMS, 2);
end;
{ 返回日期時間字串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
var
wYear, wMonth, wDay: string;
wHour, wMinute, wSecond: string;
begin
wYear := RightStr(YzIntToZeroStr(YzGetYear(ADate), 4), 2);
wMonth := YzIntToZeroStr(YzGetMonth(ADate), 2);
wDay := YzIntToZeroStr(YzGetDay(ADate), 2);
wHour := YzGetTimeStr(ATime, 'Hour');
wMinute := YzGetTimeStr(ATime, 'Minute');
wSecond := YzGetTimeStr(ATime, 'Second');
Result := wYear + wMonth + wDay + wHour + wMinute + wSecond;
end;
{ 通過窗體子串查詢窗體 }
procedure YzFindSpecWindow(ASubTitle: string);
function EnumWndProc(AWnd: THandle;AWinName: string): Boolean;stdcall;
var
WindowText: array[0..255] of Char;
WindowStr: string;
begin
GetWindowText(AWnd, WindowText, 255);
WindowStr := StrPas(WindowText);
WindowStr := COPY(WindowStr, 1, StrLen(PChar(AWinName)));
if CompareText(AWinName, WindowStr) = 0 then
begin
SetForegroundWindow(AWnd);
Result := False; Exit;
end;
Result := True;
end;
begin
EnumWindows(@EnumWndProc, LongInt(@ASubTitle));
YzDelayTime(1000);
end;
{ 獲取計算機名稱 }
function YzGetComputerName(): string;
var
pcComputer: PChar;
dwCSize: DWORD;
begin
dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
Result := '';
GetMem(pcComputer, dwCSize);
try
if Windows.GetComputerName(pcComputer, dwCSize) then
Result := pcComputer;
finally
FreeMem(pcComputer);
end;
end;
{ 判斷程序CPU佔用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
var
cnt: PCPUUsageData;
usage: Single;
begin
cnt := wsCreateUsageCounter(FindProcess(ProcessName));
while True do
begin
usage := wsGetCpuUsage(cnt);
if usage <= CPUUsage then
begin
wsDestroyUsageCounter(cnt);
YzDelayTime(2000);
Break;
end;
YzDelayTime(10);
Application.ProcessMessages;
end;
end;
{ 分割字串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
var
TmpStr: string;
PO: integer;
begin
Terms.Clear;
if Length(Source) = 0 then Exit; { 長度為0則退出 }
PO := Pos(Separator, Source);
if PO = 0 then
begin
Terms.Add(Source);
Exit;
end;
while PO <> 0 do
begin
TmpStr := Copy(Source, 1, PO - 1);{ 複製字元 }
Terms.Add(TmpStr); { 新增到列表 }
Delete(Source, 1, PO); { 刪除字元和分割符 }
PO := Pos(Separator, Source); { 查詢分割符 }
end;
if Length(Source) > 0 then
Terms.Add(Source); { 新增剩下的條目 }
end;
{ 切換頁面控制元件的活動頁面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
begin
if AOwerPage.ActivePage <> ANewPage then AOwerPage.ActivePage := ANewPage;
end;
{ 設定頁面控制元件標籤的可見性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
var
I: Integer;
begin
for I := 0 to PageControl.PageCount -1 do
PageControl.Pages[I].TabVisible := ShowFlag;
end;
{ 根據產品名稱獲取產品編號 }
function YZGetLevelCode(AName:string;ProductList: TStringList): string;
var
I: Integer;
TmpStr: string;
begin
Result := '';
if ProductList.Count <= 0 then Exit;
for I := 0 to ProductList.Count-1 do
begin
TmpStr := ProductList.Strings[I];
if AName = Copy(TmpStr,1, Pos('_', TmpStr)-1) then
begin
Result := Copy(TmpStr, Pos('_', TmpStr)+1, 10);
Break;
end;
end;
end;
{ 取檔案的主檔名 }
function YzGetMainFileName(AFileName:string): string;
var
TmpStr: string;
begin
if AFileName = '' then Exit;
TmpStr := ExtractFileName(AFileName);
Result := Copy(TmpStr, 1, Pos('.', TmpStr) - 1);
end;
{ 按下一個鍵 }
procedure YzPressOneKey(AByteCode: Byte);
begin
keybd_event(AByteCode, 0, 0, 0);
YzDelayTime(100);
keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
YzDelayTime(400);
end;
{ 按下一個指定次數的鍵 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
var
I: Integer;
begin
for I := 1 to ATimes do
begin
keybd_event(AByteCode, 0, 0, 0);
YzDelayTime(10);
keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
YzDelayTime(150);
end;
end;
{ 按下二個鍵 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
begin
keybd_event(AFirstByteCode, 0, 0, 0);
keybd_event(ASecByteCode, 0, 0, 0);
YzDelayTime(100);
keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
YzDelayTime(400);
end;
{ 按下三個鍵 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
begin
keybd_event(AFirstByteCode, 0, 0, 0);
keybd_event(ASecByteCode, 0, 0, 0);
keybd_event(AThirdByteCode, 0, 0, 0);
YzDelayTime(100);
keybd_event(AThirdByteCode, 0, KEYEVENTF_KEYUP, 0);
keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
YzDelayTime(400);
end;
{ 建立桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
var
tmpObject: IUnknown;
tmpSLink: IShellLink;
tmpPFile: IPersistFile;
PIDL: PItemIDList;
StartupDirectory: array[0..MAX_PATH] of Char;
StartupFilename: String;
LinkFilename: WideString;
begin
StartupFilename := sPath;
tmpObject := CreateComObject(CLSID_ShellLink); { 建立建立快捷方式的外殼擴充套件 }
tmpSLink := tmpObject as IShellLink; { 取得介面 }
tmpPFile := tmpObject as IPersistFile; { 用來儲存*.lnk檔案的介面 }
tmpSLink.SetPath(pChar(StartupFilename)); { 設定notepad.exe所在路徑 }
tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); {設定工作目錄 }
SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); { 獲得桌面的Itemidlist }
SHGetPathFromIDList(PIDL, StartupDirectory); { 獲得桌面路徑 }
sShortCutName := '/' + sShortCutName + '.lnk';
LinkFilename := StartupDirectory + sShortCutName;
tmpPFile.Save(pWChar(LinkFilename), FALSE); { 儲存*.lnk檔案 }
end;
{ 刪除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);
var
PIDL : PItemIDList;
StartupDirectory: array[0..MAX_PATH] of Char;
LinkFilename: WideString;
begin
SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
SHGetPathFromIDList(PIDL,StartupDirectory);
LinkFilename := StrPas(StartupDirectory) + '/' + sShortCutName + '.lnk';
DeleteFile(LinkFilename);
end;
{ 通過游標位置進行滑鼠左鍵單擊 }
procedure YzMouseLeftClick(X, Y: Integer);
begin
SetCursorPos(X, Y);
YzDelayTime(100);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
YzDelayTime(400);
end;
{ 滑鼠左鍵雙擊 }
procedure YzMouseDoubleClick(X, Y: Integer);
begin
SetCursorPos(X, Y);
YzDelayTime(100);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
YzDelayTime(100);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
YzDelayTime(400);
end;
{ 通過視窗控制代碼進行滑鼠左鍵單擊 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
var
AHandel: THandle;
begin
AHandel := FindWindow(lpClassName, lpWindowName);
SendMessage(AHandel, WM_LBUTTONDOWN, 0, 0);
SendMessage(AHandel, WM_LBUTTONUP, 0, 0);
YzDelayTime(500);
end;
{ 等待程序結束 }
procedure YzWaitProcessExit(AProcessName: string);
begin
while True do
begin
KillByPID(FindProcess(AProcessName));
if FindProcess(AProcessName) = 0 then Break;
YzDelayTime(10);
Application.ProcessMessages;
end;
end;
{-------------------------------------------------------------
功 能: 等待視窗在指定時間後出現
參 數: lpClassName: 視窗類名
lpWindowName: 視窗標題
ASecond: 要等待的時間,"0"代表永久等待
返回值: 無
備 注: 如果指定的等待時間未到視窗已出現則立即退出
--------------------------------------------------------------}
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
ASecond: Integer = 0): THandle;overload;
var
StartTickCount, PassTickCount: LongWord;
begin
Result := 0;
{ 永久等待 }
if ASecond = 0 then
begin
while True do
begin
Result := FindWindow(lpClassName, lpWindowName);
if Result <> 0 then Break;
YzDelayTime(10);
Application.ProcessMessages;
end;
end
else { 等待指定時間 }
begin
StartTickCount := GetTickCount;
while True do
begin
Result := FindWindow(lpClassName, lpWindowName);
{ 視窗已出現則立即退出 }
if Result <> 0 then Break
else
begin
PassTickCount := GetTickCount;
{ 等待時間已到則退出 }
if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
end;
YzDelayTime(10);
Application.ProcessMessages;
end;
end;
YzDelayTime(1000);
end;
{ 等待指定視窗消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
ASecond: Integer = 0);
var
StartTickCount, PassTickCount: LongWord;
begin
if ASecond = 0 then
begin
while True do
begin
if FindWindow(lpClassName, lpWindowName) = 0 then Break;
YzDelayTime(10);
Application.ProcessMessages;
end
end
else
begin
StartTickCount := GetTickCount;
while True do
begin
{ 視窗已關閉則立即退出 }
if FindWindow(lpClassName, lpWindowName)= 0 then Break
else
begin
PassTickCount := GetTickCount;
{ 等待時間已到則退出 }
if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
end;
YzDelayTime(10);
Application.ProcessMessages;
end;
end;
YzDelayTime(500);
end;
{ 通過游標位置查詢視窗控制代碼 }
function YzWindowFromPoint(X, Y: Integer): THandle;
var
MousePoint: TPoint;
CurWindow: THandle;
hRect: TRect;
Canvas: TCanvas;
begin
MousePoint.X := X;
MousePoint.Y := Y;
CurWindow := WindowFromPoint(MousePoint);
GetWindowRect(Curwindow, hRect);
if Curwindow <> 0 then
begin
Canvas := TCanvas.Create;
Canvas.Handle := GetWindowDC(Curwindow);
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Pen.Mode := pmNotXor;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(0, 0, hRect.Right-hRect.Left, hRect.Bottom-hRect.Top);
Canvas.Free;
end;
Result := CurWindow;
end;
{ 通游標位置,視窗類名與標題查詢視窗是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
ASecond: Integer):THandle;overload;
var
MousePo: TPoint;
CurWindow: THandle;
bufClassName: array[0..MAXBYTE-1] of Char;
bufWinName: array[0..MAXBYTE-1] of Char;
StartTickCount, PassTickCount: LongWord;
begin
Result := 0;
{ 永久等待 }
if ASecond = 0 then
begin
while True do
begin
MousePo.X := X;
MousePo.Y := Y;
CurWindow := WindowFromPoint(MousePo);
GetClassName(CurWindow, bufClassName, MAXBYTE);
GetWindowText(CurWindow, bufWinname, MAXBYTE);
if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
(CompareText(StrPas(bufWinName), AWinName) = 0) then
begin
Result := CurWindow;
Break;
end;
YzDelayTime(10);
Application.ProcessMessages;
end;
end
else { 等待指定時間 }
begin
StartTickCount := GetTickCount;
while True do
begin
{ 視窗已出現則立即退出 }
MousePo.X := X;
MousePo.Y := Y;
CurWindow := WindowFromPoint(MousePo);
GetClassName(CurWindow, bufClassName, MAXBYTE);
GetWindowText(CurWindow, bufWinname, MAXBYTE);
if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
(CompareText(StrPas(bufWinName), AWinName) = 0) then
begin
Result := CurWindow; Break;
end
else
begin
PassTickCount := GetTickCount;
{ 等待時間已到則退出 }
if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
end;
YzDelayTime(10);
Application.ProcessMessages;
end;
end;
YzDelayTime(1000);
end;
{ 通過視窗控制代碼設定文字框控制元件文字 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
AText: string);overload;
var
CurWindow: THandle;
begin
CurWindow := FindWindow(lpClassName, lpWindowName);
SendMessage(CurWindow ,WM_SETTEXT, 0, Integer(PChar(AText)));
YzDelayTime(500);
end;
{ 通過游標位置設定文字框控制元件文字 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;
var
CurWindow: THandle;
begin
CurWindow := YzWindowFromPoint(X, Y);
SendMessage(CurWindow, WM_SETTEXT, 0, Integer(PChar(AText)));
YzMouseLeftClick(X, Y);
end;
{ 獲取Window作業系統語言 }
function YzGetWindowsLanguageStr: String;
var
WinLanguage: array [0..50] of char;
begin
VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
Result := StrPas(WinLanguage);
end;
procedure YzDynArraySetZero(var A);
var
P: PLongint; { 4個位元組 }
begin
P := PLongint(A); { 指向 A 的地址 }
Dec(P); { P地址偏移量是 sizeof(A),指向了陣列長度 }
P^ := 0; { 陣列長度清空 }
Dec(P); { 指向陣列引用計數 }
P^ := 0; { 陣列計數清空 }
end;
{ 動態設定解析度 }
function YzDynamicResolution(x, y: WORD): Boolean;
var
lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := x;
lpDevMode.dmPelsHeight := y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end;
end;
procedure YzSetFontMapping;
begin
SetLength(FontMapping, 3);
{ 800 x 600 }
FontMapping[0].SWidth := 800;
FontMapping[0].SHeight := 600;
FontMapping[0].FName := '宋體';
FontMapping[0].FSize := 7;
{ 1024 x 768 }
FontMapping[1].SWidth := 1024;
FontMapping[1].SHeight := 768;
FontMapping[1].FName := '宋體';
FontMapping[1].FSize := 9;
{ 1280 x 1024 }
FontMapping[2].SWidth := 1280;
FontMapping[2].SHeight := 1024;
FontMapping[2].FName := '宋體';
FontMapping[2].FSize := 11;
end;
{ 程式窗體及控制元件自適應解析度(有問題) }
procedure YzFixForm(AForm: TForm);
var
I, J: integer;
T: TControl;
begin
with AForm do
begin
for I := 0 to ComponentCount - 1 do
begin
try
T := TControl(Components[I]);
T.left := Trunc(T.left * (Screen.width / 1024));
T.top := Trunc(T.Top * (Screen.Height / 768));
T.Width := Trunc(T.Width * (Screen.Width / 1024));
T.Height := Trunc(T.Height * (Screen.Height / 768));
except
end; { try }
end; { for I }
for I:= 0 to Length(FontMapping) - 1 do
begin
if (Screen.Width = FontMapping[I].SWidth) and (Screen.Height =
FontMapping[I].SHeight) then
begin
for J := 0 to ComponentCount - 1 do
begin
try
TFontedControl(Components[J]).Font.Name := FontMapping[I].FName;
TFontedControl(Components[J]).FONT.Size := FontMapping[I].FSize;
except
end; { try }
end; { for J }
end; { if }
end; { for I }
end; { with }
end;
{ 檢測系統螢幕解析度 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;
begin
Result := True;
if (Screen.Width <> X) and (Screen.Height <> Y) then
begin
if MessageBox(Application.Handle, PChar( '系統檢測到您的螢幕解析度不是 '
+ IntToStr(X) + '×' + IntToStr(Y) + '，這將影響到系統的正常執行，'
+ '是否要自動調整螢幕解析度？'), '提示', MB_YESNO + MB_ICONQUESTION
+ MB_TOPMOST) = 6 then YzDynamicResolution(1024, 768)
else Result := False;
end;
end;
function YzGetUninstallInfo: TUninstallInfo;
const
Key = '/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/';
var
S : TStrings;
I : Integer;
J : Integer;
begin
with TRegistry.Create do
begin
S := TStringlist.Create;
J := 0;
try
RootKey:= HKEY_LOCAL_MACHINE;
OpenKeyReadOnly(Key);
GetKeyNames(S);
Setlength(Result, S.Count);
for I:= 0 to S.Count - 1 do
begin
If OpenKeyReadOnly(Key + S[I]) then
If ValueExists('DisplayName') and ValueExists('UninstallString') then
begin
Result[J].RegProgramName:= S[I];
Result[J].ProgramName:= ReadString('DisplayName');
Result[J].UninstallPath:= ReadString('UninstallString');
If ValueExists('Publisher') then
Result[J].Publisher:= ReadString('Publisher');
If ValueExists('URLInfoAbout') then
Result[J].PublisherURL:= ReadString('URLInfoAbout');
If ValueExists('DisplayVersion') then
Result[J].Version:= ReadString('DisplayVersion');
If ValueExists('HelpLink') then
Result[J].HelpLink:= ReadString('HelpLink');
If ValueExists('URLUpdateInfo') then
Result[J].UpdateInfoURL:= ReadString('URLUpdateInfo');
If ValueExists('RegCompany') then
Result[J].RegCompany:= ReadString('RegCompany');
If ValueExists('RegOwner') then
Result[J].RegOwner:= ReadString('RegOwner');
Inc(J);
end;
end;
finally
Free;
S.Free;
SetLength(Result, J);
end;
end;
end;
{ 檢測Java安裝資訊 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
var
I: Integer;
Java6Exist: Boolean;
AUninstall: TUninstallInfo;
AProgramList: TStringList;
AJavaVersion, AFilePath: string;
begin
Result := True;
Java6Exist := False;
AJavaVersion := 'J2SE Runtime Environment 5.0 Update 14';
AUninstall := YzGetUninstallInfo;
AProgramList := TStringList.Create;
for I := Low(AUninstall) to High(AUninstall) do
begin
if Pos('J2SE', AUninstall[I].ProgramName) <> 0 then
AProgramList.Add(AUninstall[I].ProgramName);
if Pos('Java(TM)', AUninstall[I].ProgramName) <> 0 then
Java6Exist := True;
end;
if Java6Exist then
begin
if CheckJava6 then
begin
MessageBox(Application.Handle, '系統檢測到您機器上安裝了Java6以上的版本，'
+ '如果影響到系統的正常執行請先將其解除安裝再重新啟動系統！', '提示',
MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
Result := False;
end;
end
else if AProgramList.Count = 0 then
begin
MessageBox(Application.Handle, '系統檢測到您機器上沒有安裝Java執行環境，'
+ '請點選 "確定" 安裝Java執行環境後再重新執行程式！',
'提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
AFilePath := ExtractFilePath(ParamStr(0)) + 'java' + '/'
+ 'jre-1_5_0_14-windows-i586-p.exe';
if FileExists(AFilePath) then WinExec(PChar(AFilePath), SW_SHOWNORMAL)
else
MessageBox(Application.Handle, '找不到Java安裝檔案，請您手動安裝！',
'提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
Result := False;
end;
AProgramList.Free;
end;
{-------------------------------------------------------------
功能: 視窗自適應螢幕大小
引數: Form: 需要調整的Form
OrgWidth：開發時螢幕的寬度
OrgHeight：開發時螢幕的高度
--------------------------------------------------------------}
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
begin
with Form do
begin
if (Screen.width <> OrgWidth) then
begin
Scaled := True;
Height := longint(Height) * longint(Screen.height) div OrgHeight;
Width := longint(Width) * longint(Screen.Width) div OrgWidth;
ScaleBy(Screen.Width, OrgWidth);
end;
end;
end;
{ 設定視窗為當前窗體 }
procedure YzBringMyAppToFront(AppHandle: THandle);
var
Th1, Th2: Cardinal;
begin
Th1 := GetCurrentThreadId;
Th2 := GetWindowThreadProcessId(GetForegroundWindow, NIL);
AttachThreadInput(Th2, Th1, TRUE);
try
SetForegroundWindow(AppHandle);
finally
AttachThreadInput(Th2, Th1, TRUE);
end;
end;
{ 獲取資料夾檔案數量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
var
SearchRec: TSearchRec;
Founded: integer;
begin
Result := 0;
if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
while Founded = 0 do
begin
Inc(Result);
if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
(SubDir = True) then
Inc(Result, YzGetDirFiles(Dir + SearchRec.Name, True));
Founded := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
{ 算術舍入法的四捨五入取整函式 }
function YzRoundEx (const Value: Real): LongInt;
var
x: Real;
begin
x := Value - Trunc(Value);
if x >= 0.5 then
Result := Trunc(Value) + 1
else Result := Trunc(Value);
end;
{ 獲取檔案大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;
var
SearchRec: TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else
Result := -1;
Result := YzRoundEx(Result / 1024);
end;
{ 獲取檔案大小(位元組) }
function YzGetFileSize_Byte(const FileName: String): LongInt;
var
SearchRec: TSearchRec;
begin
if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
Result := SearchRec.Size
else
Result := -1;
end;
{ 獲取資料夾大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
var
SearchRec: TSearchRec;
Founded: integer;
begin
Result := 0;
if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
while Founded = 0 do
begin
Inc(Result, SearchRec.size);
if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
(SubDir = True) then
Inc(Result, YzGetDirSize(Dir + SearchRec.Name, True));
Founded := FindNext(SearchRec);
end;
FindClose(SearchRec);
Result := YzRoundEx(Result / 1024);
end;
{-------------------------------------------------------------
功能: 彈出選擇目錄對話方塊
引數: const iMode: 選擇模式
const sInfo: 對話方塊提示資訊
返回值: 如果取消取返回為空，否則返回選中的路徑
--------------------------------------------------------------}
function YzSelectDir(const iMode: integer;const sInfo: string): string;
var
Info: TBrowseInfo;
IDList: pItemIDList;
Buffer: PChar;
begin
Result:='';
Buffer := StrAlloc(MAX_PATH);
with Info do
begin
hwndOwner := application.mainform.Handle; { 目錄對話方塊所屬的視窗控制代碼 }
pidlRoot := nil; { 起始位置，預設為我的電腦 }
pszDisplayName := Buffer; { 用於存放選擇目錄的指標 }
lpszTitle := PChar(sInfo);
{ 此處表示顯示目錄和檔案，如果只顯示目錄則將後一個去掉即可 }
if iMode = 1 then
ulFlags := BIF_RETURNONLYFSDIRS or BIF_BROWSEINCLUDEFILES
else
ulFlags := BIF_RETURNONLYFSDIRS;
lpfn := nil; { 指定回撥函式指標 }
lParam := 0; { 傳遞給回撥函式引數 }
IDList := SHBrowseForFolder(Info); { 讀取目錄資訊 }
end;
if IDList <> nil then
begin
SHGetPathFromIDList(IDList, Buffer); { 將目錄資訊轉化為路徑字串 }
Result := strpas(Buffer);
end;
StrDispose(buffer);
end;
{ 獲取指定路徑下資料夾的個數 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
var
SRec: TSearchRec;
begin
if not Assigned(List) then List:= TStringList.Create;
FindFirst(Path + '*.*', faDirectory, SRec);
if ShowPath then
List.Add(Path + SRec.Name)
else
List.Add(SRec.Name);
while FindNext(SRec) = 0 do
if ShowPath then
List.Add(Path + SRec.Name)
else
List.Add(SRec.Name);
FindClose(SRec);
end;
{ 禁用窗器控制元件的所有子控制元件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
var
I: Integer;
begin
for I := 0 to AOwer.ControlCount - 1 do
AOwer.Controls[I].Enabled := AState;
end;
{ 模擬鍵盤按鍵操作(處理位元組碼) }
procedure YzFKeyent(byteCard: byte);
var
vkkey: integer;
begin
vkkey := VkKeyScan(chr(byteCard));
if (chr(byteCard) in ['A'..'Z']) then
begin
keybd_event(VK_SHIFT, 0, 0, 0);
keybd_event(byte(byteCard), 0, 0, 0);
keybd_event(VK_SHIFT, 0, 2, 0);
end
else if chr(byteCard) in ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
'_', '+', '|', '{', '}', ':', '"', '<', '>', '?', '~'] then
begin
keybd_event(VK_SHIFT, 0, 0, 0);
keybd_event(byte(vkkey), 0, 0, 0);
keybd_event(VK_SHIFT, 0, 2, 0);
end
else { if byteCard in [8,13,27,32] }
begin
keybd_event(byte(vkkey), 0, 0, 0);
end;
end;
{ 模擬鍵盤按鍵(處理字元) }
procedure YzFKeyent(strCard: string);
var
str: string;
strLength: integer;
I: integer;
byteSend: byte;
begin
str := strCard;
strLength := length(str);
for I := 1 to strLength do
begin
byteSend := byte(str[I]);
YzFKeyent(byteSend);
end;
end;
{ 鎖定視窗位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
var
CurWindow: THandle;
_wndRect: TRect;
begin
CurWindow := 0;
while True do
begin
CurWindow := FindWindow(ClassName,WinName);
if CurWindow <> 0 then Break;
YzDelayTime(10);
Application.ProcessMessages;
end;
GetWindowRect(CurWindow,_wndRect);
if ( _wndRect.Left <> poX) or ( _wndRect.Top <> poY) then
begin
MoveWindow(CurWindow,
poX,
poY,
(_wndRect.Right-_wndRect.Left),
(_wndRect.Bottom-_wndRect.Top),
TRUE);
end;
YzDelayTime(1000);
end;
{
註冊一個DLL形式或OCX形式的OLE/COM控制元件
引數strOleFileName為一個DLL或OCX檔名，
引數OleAction表示註冊操作型別，1表示註冊，0表示解除安裝
返回值True表示操作執行成功，False表示操作執行失敗
}
function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
const
RegisterOle = 1; { 註冊 }
UnRegisterOle = 0; { 解除安裝 }
type
TOleRegisterFunction = function: HResult; { 註冊或解除安裝函式的原型 }
var
hLibraryHandle: THandle; { 由LoadLibrary返回的DLL或OCX控制代碼 }
hFunctionAddress: TFarProc; { DLL或OCX中的函式控制代碼，由GetProcAddress返回 }
RegFunction: TOleRegisterFunction; { 註冊或解除安裝函式指標 }
begin
Result := FALSE;
{ 開啟OLE/DCOM檔案，返回的DLL或OCX控制代碼 }
hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));
if (hLibraryHandle > 0) then { DLL或OCX控制代碼正確 }
try
{ 返回註冊或解除安裝函式的指標 }
if (OleAction = RegisterOle) then { 返回註冊函式的指標 }
hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer'))
{ 返回解除安裝函式的指標 }
else
hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer'));
if (hFunctionAddress <> NIL) then { 註冊或解除安裝函式存在 }
begin
{ 獲取操作函式的指標 }
RegFunction := TOleRegisterFunction(hFunctionAddress);
{ 執行註冊或解除安裝操作，返回值>=0表示執行成功 }
if RegFunction >= 0 then
Result := true;
end;
finally
{ 關閉已開啟的OLE/DCOM檔案 }
FreeLibrary(hLibraryHandle);
end;
end;
function YzListViewColumnCount(mHandle: THandle): Integer;
begin
Result := Header_GetItemCount(ListView_GetHeader(mHandle));
end; { ListViewColumnCount }
function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
vColumnCount: Integer;
vItemCount: Integer;
I, J: Integer;
vBuffer: array[0..255] of Char;
vProcessId: DWORD;
vProcess: THandle;
vPointer: Pointer;
vNumberOfBytesRead: Cardinal;
S: string; vItem: TLVItem;
begin
Result := False;
if not Assigned(mStrings) then Exit;
vColumnCount := YzListViewColumnCount(mHandle);
if vColumnCount <= 0 then Exit;
vItemCount := ListView_GetItemCount(mHandle);
GetWindowThreadProcessId(mHandle, @vProcessId);
vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ
or PROCESS_VM_WRITE, False, vProcessId);
vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT,
PAGE_READWRITE);
mStrings.BeginUpdate;
try
mStrings.Clear;
for I := 0 to vItemCount - 1 do
begin
S := '';
for J := 0 to vColumnCount - 1 do
begin
with vItem do
begin
mask := LVIF_TEXT;
iItem := I;
iSubItem := J;
cchTextMax := SizeOf(vBuffer);
pszText := Pointer(Cardinal(vPointer) + SizeOf(TLVItem));
end;
WriteProcessMemory(vProcess, vPointer, @vItem,
SizeOf(TLVItem), vNumberOfBytesRead);
SendMessage(mHandle, LVM_GETITEM, I, lparam(vPointer));
ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
@vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
S := S + #9 + vBuffer;
end;
Delete(S, 1, 1);
mStrings.Add(S);
end;
finally
VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
CloseHandle(vProcess); mStrings.EndUpdate;
end;
Result := True;
end; { GetListViewText }
{ 刪除目錄樹 }
function YzDeleteDirectoryTree(Path: string): boolean;
var
SearchRec: TSearchRec;
SFI: string;
begin
Result := False;
if (Path = '') or (not DirectoryExists(Path)) then exit;
if Path[length(Path)] <> '/' then Path := Path + '/';
SFI := Path + '*.*';
if FindFirst(SFI, faAnyFile, SearchRec) = 0 then
begin
repeat
begin
if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
Continue;
if (SearchRec.Attr and faDirectory <> 0) then
begin
if not YzDeleteDirectoryTree(Path + SearchRec.name) then
Result := FALSE;
end
else
begin
FileSetAttr(Path + SearchRec.Name, 128);
DeleteFile(Path + SearchRec.Name);
end;
end
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
FileSetAttr(Path, 0);
if RemoveDir(Path) then
Result := TRUE
else
Result := FALSE;
end;
{ Jpg格式轉換為bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;
begin
Result := nil;
if Assigned(Jpg) then
begin
Result := TBitmap.Create;
Jpg.DIBNeeded;
Result.Assign(Jpg);
end;
end;
{ 設定程式自啟動函式 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
var
AMainFName: string;
Reg: TRegistry;
begin
Result := true;
AMainFName := YzGetMainFileName(AFilePath);
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
try
Reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
if AFlag = False then { 取消自啟動 }
Reg.DeleteValue(AMainFName)
else { 設定自啟動 }
Reg.WriteString(AMainFName, '"' + AFilePath + '"')
except
Result := False;
end;
Reg.CloseKey;
Reg.Free;
end;
{ 檢測URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;
var
hSession, hfile, hRequest: HINTERNET;
dwindex, dwcodelen: dword;
dwcode: array[1..20] of Char;
res: PChar;
begin
Result := False;
try
if Pos('http://',LowerCase(url)) = 0 then url := 'http://' + url;
{ Open an internet session }
hSession:=InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil, 0);
if Assigned(hsession) then
begin
hfile := InternetOpenUrl(hsession, PChar(url), nil, 0,INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile,HTTP_QUERY_STATUS_CODE,@dwcode,dwcodeLen,dwIndex);
res := PChar(@dwcode);
Result := (res = '200') or (res = '302');
if Assigned(hfile) then InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
except
end;
end;
{ 獲取程式可執行檔名 }
function YzGetExeFName: string;
begin
Result := ExtractFileName(Application.ExeName);
end;
{ 目錄瀏覽對話方塊函式 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
var
Info: TBrowseInfo;
Dir: array[0..260] of char;
ItemId: PItemIDList;
begin
with Info do
begin
hwndOwner := AOwer.Handle;
pidlRoot := nil;
pszDisplayName := nil;
lpszTitle := PChar(ATitle);
ulFlags := 0;
lpfn := nil;
lParam := 0;
iImage := 0;
end;
ItemId := SHBrowseForFolder(Info);
SHGetPathFromIDList(ItemId,@Dir);
Result := string(Dir);
end;
{ 重啟計算機 }
function YzShutDownSystem(AFlag: Integer):BOOL;
var
hProcess,hAccessToken: THandle;
LUID_AND_ATTRIBUTES: TLUIDAndAttributes;
TOKEN_PRIVILEGES: TTokenPrivileges;
BufferIsNull: DWORD;
Const
SE_SHUTDOWN_NAME='SeShutdownPrivilege';
begin
hProcess:=GetCurrentProcess();
OpenProcessToken(hprocess, TOKEN_ADJUST_PRIVILEGES+TOKEN_QUERY, hAccessToken);
LookupPrivilegeValue(Nil, SE_SHUTDOWN_NAME, LUID_AND_ATTRIBUTES.Luid);
LUID_AND_ATTRIBUTES.Attributes := SE_PRIVILEGE_ENABLED;
TOKEN_PRIVILEGES.PrivilegeCount := 1;
TOKEN_PRIVILEGES.Privileges[0] := LUID_AND_ATTRIBUTES;
BufferIsNull := 0;
AdjustTokenPrivileges(hAccessToken, False, TOKEN_PRIVILEGES, sizeof(
TOKEN_PRIVILEGES) ,Nil, BufferIsNull);
Result := ExitWindowsEx(AFlag, 0);
end;
{ 程式執行後刪除自身 }
procedure YzDeleteSelf;
var
hModule: THandle;
buff: array[0..255] of Char;
hKernel32: THandle;
pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;
begin
hModule := GetModuleHandle(nil);
GetModuleFileName(hModule, buff, sizeof(buff));
CloseHandle(THandle(4));
hKernel32 := GetModuleHandle('KERNEL32');
pExitProcess := GetProcAddress(hKernel32, 'ExitProcess');
pDeleteFileA := GetProcAddress(hKernel32, 'DeleteFileA');
pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile');
asm
LEA EAX, buff
PUSH 0
PUSH 0
PUSH EAX
PUSH pExitProcess
PUSH hModule
PUSH pDeleteFileA
PUSH pUnmapViewOfFile
RET
end;
end;
{ 程式重啟 }
procedure YzAppRestart;
var
AppName : PChar;
begin
AppName := PChar(Application.ExeName) ;
ShellExecute(Application.Handle,'open', AppName, nil, nil, SW_SHOWNORMAL);
KillByPID(GetCurrentProcessId);
end;
{ 壓縮Access資料庫 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
var
SPath, FConStr, TmpConStr: string;
SFile: array[0..254] of Char;
STempFileName: string;
JE: OleVariant;
function GetTempDir: string;
var
Buffer: array[0..MAX_PATH] of Char;
begin
ZeroMemory(@Buffer, MAX_PATH);
GetTempPath(MAX_PATH, Buffer);
Result := IncludeTrailingBackslash(StrPas(Buffer));
end;
begin
Result := False;
SPath := GetTempDir; { 取得Windows的Temp路徑 }
{ 取得Temp檔名,Windows將自動建立0位元組檔案 }
GetTempFileName(PChar(SPath), '~ACP', 0, SFile);
STempFileName := SFile;
{ 刪除Windows建立的0位元組檔案 }
if not DeleteFile(STempFileName) then Exit;
try
JE := CreateOleObject('JRO.JetEngine');
{ 壓縮資料庫 }
FConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + AFileName
+ ';Jet OLEDB:DataBase PassWord=' + APassWord;
TmpConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + STempFileName
+ ';Jet OLEDB:DataBase PassWord=' + APassWord;
JE.CompactDatabase(FConStr, TmpConStr);
{ 覆蓋源資料庫檔案 }
Result := CopyFile(PChar(STempFileName), PChar(AFileName), False);
{ 刪除臨時檔案 }
DeleteFile(STempFileName);
except
Application.MessageBox('壓縮資料庫失敗！', '提示', MB_OK +
MB_ICONINFORMATION);
end;
end;
{ 標題:獲取其他程序中TreeView的文字 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
var
vParentID: HTreeItem;
begin
Result := nil;
if (mHandle <> 0) and (mTreeItem <> nil) then
begin
Result := TreeView_GetChild(mHandle, mTreeItem);
if Result = nil then
Result := TreeView_GetNextSibling(mHandle, mTreeItem);
vParentID := mTreeItem;
while (Result = nil) and (vParentID <> nil) do
begin
vParentID := TreeView_GetParent(mHandle, vParentID);
Result := TreeView_GetNextSibling(mHandle, vParentID);
end;
end;
end; { TreeNodeGetNext }
function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
var
vParentID: HTreeItem;
begin
Result := -1;
if (mHandle <> 0) and (mTreeItem <> nil) then
begin
vParentID := mTreeItem;
repeat
Inc(Result);
vParentID := TreeView_GetParent(mHandle, vParentID);
until vParentID = nil;
end;
end; { TreeNodeGetLevel }
function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
vItemCount: Integer;
vBuffer: array[0..255] of Char;
vProcessId: DWORD;
vProcess: THandle;
vPointer: Pointer;
vNumberOfBytesRead: Cardinal;
I: Integer;
vItem: TTVItem;
vTreeItem: HTreeItem;
begin
Result := False;
if not Assigned(mStrings) then Exit;
GetWindowThreadProcessId(mHandle, @vProcessId);
vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE, False, vProcessId);
vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or
MEM_COMMIT, PAGE_READWRITE);
mStrings.BeginUpdate;
try
mStrings.Clear;
vItemCount := TreeView_GetCount(mHandle);
vTreeItem := TreeView_GetRoot(mHandle);
for I := 0 to vItemCount - 1 do
begin
with vItem do begin
mask := TVIF_TEXT; cchTextMax := SizeOf(vBuffer);
pszText := Pointer(Cardinal(vPointer) + SizeOf(vItem));
hItem := vTreeItem;
end;
WriteProcessMemory(vProcess, vPointer, @vItem, SizeOf(vItem),
vNumberOfBytesRead);
SendMessage(mHandle, TVM_GETITEM, 0, lparam(vPointer));
ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
@vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
mStrings.Add(StringOfChar(#9, YzTreeNodeGetLevel(mHandle, vTreeItem)) + vBuffer);
vTreeItem := YzTreeNodeGetNext(mHandle, vTreeItem);
end;
finally
VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
CloseHandle(vProcess); mStrings.EndUpdate;
end;
Result := True;
end; { GetTreeViewText }
{ 獲取其他程序中ListBox和ComboBox的內容 }
function YzGetListBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
vItemCount: Integer;
I: Integer;
S: string;
begin
Result := False;
if not Assigned(mStrings) then Exit;
mStrings.BeginUpdate;
try
mStrings.Clear;
vItemCount := SendMessage(mHandle, LB_GETCOUNT, 0, 0);
for I := 0 to vItemCount - 1 do
begin
SetLength(S, SendMessage(mHandle, LB_GETTEXTLEN, I, 0));
SendMessage(mHandle, LB_GETTEXT, I, Integer(@S[1]));
mStrings.Add(S);
end;
SetLength(S, 0);
finally
mStrings.EndUpdate;
end;
Result := True;
end; { GetListBoxText }
function YzGetComboBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
vItemCount: Integer;
I: Integer;
S: string;
begin
Result := False;
if not Assigned(mStrings) then Exit;
mStrings.BeginUpdate;
try
mStrings.Clear;
vItemCount := SendMessage(mHandle, CB_GETCOUNT, 0, 0);
for I := 0 to vItemCount - 1 do
begin
SetLength(S, SendMessage(mHandle, CB_GETLBTEXTLEN, I, 0));
SendMessage(mHandle, CB_GETLBTEXT, I, Integer(@S[1]));
mStrings.Add(S);
end;
SetLength(S, 0);
finally
mStrings.EndUpdate;
end;
Result := True;
end; { GetComboBoxText }
{ 獲取本地Application Data目錄路徑 }
function YzLocalAppDataPath : string;
const
SHGFP_TYPE_CURRENT = 0;
var
Path: array [0..MAX_PATH] of char;
begin
SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @path[0]) ;
Result := Path;
end;
{ 獲取Windows當前登入的使用者名稱 }
function YzGetWindwosUserName: String;
var
pcUser: PChar;
dwUSize: DWORD;
begin
dwUSize := 21;
result := '';
GetMem(pcUser, dwUSize);
try
if Windows.GetUserName(pcUser, dwUSize) then
Result := pcUser
finally
FreeMem(pcUser);
end;
end;
{-------------------------------------------------------------
功 能: delphi 列舉托盤圖示
參 數: AFindList: 返回找到的托盤列表資訊
返回值: 成功為True,反之為False
備 注: 返回的格式為: 位置_名稱_視窗控制代碼_程序ID
--------------------------------------------------------------}
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
var
wd: HWND;
wtd: HWND;
wd1: HWND;
pid: DWORD;
hd: THandle;
num, i: integer;
n: ULONG;
p: TTBBUTTON;
pp: ^TTBBUTTON;
x: string;
name: array[0..255] of WCHAR;
whd, proid: ulong;
temp: strin