网络文本函数(二).txt

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;
 

类别：程序设计 |  | 添加到搜藏 | 分享到i贴吧 | 浏览(43) | 评论 (0)  上一篇：网络收集与整理的一些Delphi函数...    下一篇：网络收集与整理的一些Delphi函数... 相关文章：? DELPHI的Split函数的各种实现方...　　　　　　　　　 ? delphi Date函数列表
? delphi 同级节点间比较名称是否...　　　　　　　　　 ? Delphi写的验证身份证号有效性函...
? Delphi过程函数传递参数的几种方...　　　　　　　　　 ? 二代身份证读卡器接口函数Delphi...
? 身份证号验证函数和身份证号15位...　　　　　　　　　 ? Delphi 中相对路径与绝对路径,系...
? DELPHI中Format函数功能及用法详...　　　　　　　　　 ? 在Delphi中巧用Windows 的API函...
更多>>
 最近读者： 登录后，您就出现在这里。 
    
 网友评论：     发表评论：  
内　容：  
  
      取消回复

     

?2010 Baidu