Delphi2007.net 首页

// 取得用户名称
function GetUserName: AnsiString;
var
  lpUserName: PAnsiChar;
  lpnLength: DWORD;
begin
  Result := '';
  lpnLength := 0;
  // 取得字串长度
  WNetGetUser(nil, nil, lpnLength);
  if lpnLength > 0 then
  begin
    GetMem(lpUserName, lpnLength);
    if WNetGetUser(nil, lpUserName, lpnLength) = NO_ERROR then
      Result := lpUserName;
    FreeMem(lpUserName, lpnLength);
  end;
end;

// 取得 Windows 产品序号   uses  Registry
function GetWindowsProductID: string;
var
  reg: TRegistry;
begin
  Result := '';
  reg := TRegistry.Create;
  with reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
    Result := ReadString('ProductID');
  end;
  reg.Free;
end;


//获取 Windows 和 System 目录
var
  // 开辟缓冲区
  s1, s2: array[1..40] of char;

  GetWindowsDirectory(@s1, 40);
  GetSystemDirectory(@s2, 40);


//获取文件版本信息
procedure TForm1.GetVersionInfo(info: string);
const
  n_Info = 10;
  InfoStr : array[1..n_Info] of String = ('CompanyName', 'FileDescription', 'FileVersion',
    'InteralName', 'LegalCopyright', 'LegalTradeMarks', 'OriginalFilename', 'ProductName',
    'ProductVersion', 'Comments');
var
  BuffSize, Len, i: Cardinal;
  Buff, Value: PChar;
begin
  //将版本信息读入缓冲区
  BuffSize := GetFileVersionInfoSize(PChar(Info), BuffSize);
  if BuffSize > 0 then
  begin
    Buff := AllocMem(BuffSize);
    Memo1.Lines.Add('FileVersionInfoSize='+IntToStr(BuffSize));
    GetFileVersionInfo(PChar(Info), 0, BuffSize, Buff);
    Info := Info + ':';
    for i := 1 to n_Info do
      if VerQueryValue(Buff, PChar('StringFileInfo\080403A8\'+InfoStr[i]), Pointer(Value), Len) then
        Info := Info + #13 + InfoStr[i] + '=' + Value;
    //释放内存
    FreeMem(Buff, BuffSize);
    ShowMessage(Info);
  end
  else
    ShowMessage('No FileVersionInfo found');
end; 


//动态调整显示器的分辨率
function DynamicResolution(X, Y: WORD): BOOL;
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 TForm1.Button1Click(Sender: TObject);
var
  hCurWindow: HWnd;
  WinText: array[1..255] of char;
begin
  // 获取第一个窗口的句柄
  hCurWindow := GetWindow(handle, GW_HWNDFIRST);
  while hCurWindow <> 0 do
  begin
    if GetWindowText(hCurWindow, @WinText, 255) > 0 then
      Memo1.Lines.Add(StrPas(@WinText));
    hCurWindow := GetWindow(hCurWindow, GW_HWNDNEXT);
  end;
end;


// 获取内存信息
procedure TForm1.Button1Click(Sender: TObject);
var
  MemInfo: MemoryStatus;
begin
  // 用 sizeof(MemoryStatus) 填充 dwLength 成员
  MemInfo.dwLength := sizeof(MemoryStatus);
  // 获取内存信息
  GlobalMemoryStatus(MemInfo);
  // 内存使用百分比
  Edit1.Text := IntToStr(MemInfo.dwMemoryLoad) + '%';
  // 总物理内存(字节)
  Edit2.Text := IntToStr(MemInfo.dwTotalPhys);
  // 未使用物理内存(字节)
  Edit3.Text := IntToStr(MemInfo.dwAvailPhys);
  // 交换文件大小(字节)
  Edit4.Text := IntToStr(MemInfo.dwTotalPageFile);
  // 未使用交换文件大小(字节)
  Edit5.Text := IntToStr(MemInfo.dwAvailPageFile);
  // 虚拟内存空间大小(字节)
  Edit6.Text := IntToStr(MemInfo.dwTotalVirtual);
  // 未使用虚拟内存大小(字节)
  Edit7.Text := IntToStr(MemInfo.dwAvailVirtual);
end;


//设置IE默认主页
procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.Access := KEY_ALL_ACCESS;
  Reg.OpenKey('\Software\Microsoft\Internet Explorer\Main\', False);
  Reg.WriteString('Start Page', Edit1.Text);
  Reg.CloseKey;
  Reg.Free;
end;


//获取主机的IP地址
//返回 ISP 分配给你的 IP 地址
function LocalIP: string;
type
  TaPInAddr = array[0..10] of PInAddr;  //PInAddr 类型的指针数组
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  i: integer;
  GInitData: TWSADATA;
begin
  //在应用程序或 DLL 调用任何 Windows Sockets 函数之前， WSAStartup 函数必须首先得以调用
  WSAStartup($101, GInitData);
  //WSAStartup(MAKEWORD(2, 2), GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));  //返回主机名
  phe := GetHostByName(Buffer);  //返回与主机名相关的主机信息
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);  //强制类型转换
  i := 0;
  while pptr^[i] <> nil do
  begin
    result := StrPas(inet_ntoa(pptr^[i]^));  //IP 地址到 ASCII 字符串的转换
    inc(i);
  end;
  WSACleanup;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  FullRgn, ClientRgn, ButtonRgn: THandle;
  Margin, x, y: integer;
begin
  Top := Screen.Height - Label1.Height - 30;
  Left := Screen.Width - Label1.Width - 5;
  Height := Label1.Height;
  Width := Label1.Width;
  Margin := (Width - ClientWidth) div 2;
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  x := Margin;
  y := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn(x, y, x + ClientWidth, y + ClientHeight);
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
  x := x + Label1.Left;
  y := y + Label1.Top;
  ButtonRgn := CreateRectRgn(x, y, x + Label1.Width, y + Label1.Height);
  CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
  SetWindowRgn(Handle, FullRgn, True);
  //隐藏任务栏图标
  ShowWindow(Application.Handle, SW_HIDE);
  SetWindowLong(Application.Handle, GWL_EXSTYLE, GetWindowLong(Application.Handle, GWL_EXSTYLE)
    or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
  ShowWindow(Application.Handle, SW_SHOW); 
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := 'IP: ' + LocalIP;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
  Clipboard.SetTextBuf(PChar(Copy(Label1.Caption, 5, 255)));
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.Label1StartDrag(Sender: TObject;
  var DragObject: TDragObject);
const
  SC_DRAGMOVE = $f012;
begin
  ReleaseCapture;
  TWinControl(Application.MainForm).Perform(WM_SYSCOMMAND, SC_MOVE, 0);
end;


//静态调用Dll
function ShowGkrongMsg(Text: string; Caption: string; ShowType: string; ShowIcon: integer; OptionText: string; ShowTime: Integer): integer; stdcall; external 'GkrongD.dll';
//动态调用Dll
type
  TShowGkrongMsg = function(Text: string; Caption: string; ShowType: string; ShowIcon: integer; OptionText: string; ShowTime: Integer): integer; stdcall;

var
  GkrongDll: THandle;

procedure TForm1.FormCreate(Sender: TObject);
begin
  GkrongDll := LoadLibrary('GkrongD.dll');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ShowGkrongMsg: TShowGkrongMsg;
begin
  ShowGkrongMsg := GetProcAddress(GkrongDll, 'ShowGkrongMsg');
  if (@ShowGkrongMsg = nil) then RaiseLastWin32Error;
  ShowMessage(IntToStr(ShowGkrongMsg('sgsadfasdg')));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeLibrary(GkrongDll);
end;