网络文本函数(三)

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: string;
sp: ^TTBBUTTON;
_sp: TTBButton;
begin
Result := False;
wd := FindWindow('Shell_TrayWnd', nil);
if (wd = 0) then Exit;

wtd := FindWindowEx(wd, 0, 'TrayNotifyWnd', nil);
if (wtd = 0) then Exit;

wtd := FindWindowEx(wtd, 0, 'SysPager', nil);
if (wtd = 0) then Exit;

wd1 := FindWindowEx(wtd, 0, 'ToolbarWindow32', nil);
if (wd1 = 0) then Exit;

pid := 0;
GetWindowThreadProcessId(wd1, @pid);
if (pid = 0) then Exit;

hd := OpenProcess(PROCESS_ALL_ACCESS, true, pid);
if (hd = 0) then Exit;
num := SendMessage(wd1, TB_BUTTONCOUNT, 0, 0);
sp := @_sp;
for i := 0 to num do
begin
    SendMessage(wd1, TB_GETBUTTON, i, integer(sp));
    pp := @p;
    ReadProcessMemory(hd, sp, pp, sizeof(p), n);
    name[0] := Char(0);
    if (Cardinal(p.iString) <> $FFFFFFFF) then
    begin
      try
        ReadProcessMemory(hd, pointer(p.iString), @name, 255, n);
        name[n] := Char(0);
      except
      end;
      temp := name;
      try
        whd := 0;
        ReadProcessMemory(hd, pointer(p.dwData), @whd, 4, n);
      except
      end;
      proid := 0;
      GetWindowThreadProcessId(whd, @proid);
      AFindList.Add(Format('%d_%s_%x_%x', [i, temp, whd, proid]));
      if CompareStr(temp, ADestStr) = 0 then Result := True;
    end;
end;
end;

{ 获取SQL Server用户数据库列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
var
PQuery: TADOQuery;
ConnectStr: string;
begin
ConnectStr := 'Provider=SQLOLEDB.1;Password=' + ALoginPwd
    + ';Persist Security Info=True;User ID=sa;Initial Catalog=master'
    + ';Data Source=' + ADBHostIP;
ADBList.Clear;
PQuery := TADOQuery.Create(nil);
try
    PQuery.ConnectionString := ConnectStr;
    PQuery.SQL.Text:='select name from sysdatabases where dbid > 6';
    PQuery.Open;
    while not PQuery.Eof do
    begin
      ADBList.add(PQuery.Fields[0].AsString);
      PQuery.Next;
    end;
finally
    PQuery.Free;
end;
end;

{ 检测数据库中是否存在给定的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
var
FConnection: TADOConnection;
begin
FConnection := TADOConnection.Create(nil);
try
    FConnection.LoginPrompt := False;
    FConnection.Connected := False;
    FConnection.ConnectionString := ConncetStr;
    FConnection.Connected := True;
    FConnection.GetTableNames(ATableList, False);
finally
    FConnection.Free;
end;
end;

{ 将域名解释成IP地址 }
function YzDomainToIP(HostName: string): string;
type
tAddr = array[0..100] of PInAddr;
pAddr = ^tAddr;
var
I: Integer;
WSA: TWSAData;
PHE: PHostEnt;
P: pAddr;
begin
Result := '';
WSAStartUp($101, WSA);
try
    PHE := GetHostByName(pChar(HostName));
    if (PHE <> nil) then
    begin
      P := pAddr(PHE^.h_addr_list);
      I := 0;
      while (P^[I] <> nil) do
      begin
        Result := (inet_nToa(P^[I]^));
        Inc(I);
      end;
    end;
except
end;
WSACleanUp;
end;

{ 移去系统托盘失效图标 }
procedure YzRemoveDeadIcons();
var
hTrayWindow: HWND;
rctTrayIcon: TRECT;
nIconWidth, nIconHeight:integer;
CursorPos: TPoint;
nRow, nCol: Integer;
Begin
//Get tray window handle and bounding rectangle
hTrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd ', nil), 0, 'TrayNotifyWnd ', nil);
if Not (GetWindowRect(hTrayWindow, rctTrayIcon)) then Exit;
//Get small icon metrics
nIconWidth := GetSystemMetrics(SM_CXSMICON);
nIconHeight := GetSystemMetrics(SM_CYSMICON);
//Save current mouse position   }
GetCursorPos(CursorPos);
//Sweep the mouse cursor over each icon in the tray in both dimensions
for nRow := 0 To ((rctTrayIcon.bottom - rctTrayIcon.top) div nIconHeight) Do
Begin
    for nCol := 0 To ((rctTrayIcon.right - rctTrayIcon.left) div nIconWidth) Do
    Begin
      SetCursorPos(rctTrayIcon.left + nCol * nIconWidth + 5,
        rctTrayIcon.top + nRow * nIconHeight + 5);
      Sleep(0);
    end;
end;
//Restore mouse position
SetCursorPos(CursorPos.x, CursorPos.x);
//Redraw tray window(to fix bug in multi-line tray area)
RedrawWindow(hTrayWindow, nil, 0, RDW_INVALIDATE Or RDW_ERASE Or RDW_UPDATENOW);
end;

{ 转移程序占用内存至虚拟内存 }
procedure YzClearMemory;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
    Application.ProcessMessages;
end;
end;

{ 检测允许试用的天数是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;
var
Reg_ID, Pre_ID: TDateTime;
FRegister: TRegistry;
begin
{ 初始化为试用没有到期 }
Result := True;
FRegister := TRegistry.Create;
try
    with FRegister do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('Software/Microsoft/Windows/CurrentSoftware/'
        + YzGetMainFileName(Application.ExeName), True) then
      begin
        if ValueExists('DateTag') then
        begin
          Reg_ID := ReadDate('DateTag');
          if Reg_ID = 0 then Exit;
          Pre_ID := ReadDate('PreDate');
          { 允许使用的时间到 }
          if ((Reg_ID <> 0) and (Now - Reg_ID > AllowDays)) or
            (Pre_ID <> Reg_ID) or (Reg_ID > Now) then
          begin
            { 防止向前更改日期 }
            WriteDateTime('PreDate', Now + 20000);
            Result := False;
          end;
        end
        else
        begin
          { 首次运行时保存初始化数据 }
          WriteDateTime('PreDate', Now);
          WriteDateTime('DateTag', Now);
        end;
      end;
    end;
finally
    FRegister.Free;
end;
end;

{ 指定长度的随机小写字符串函数 }
function YzRandomStr(aLength: Longint): string;
var
X: Longint;
begin
if aLength <= 0 then exit;
SetLength(Result, aLength);
for X := 1 to aLength do
    Result[X] := Chr(Random(26) + 65);
Result := LowerCase(Result);
end;

end.