myfuctions.pas

实现了在开发的数据库程序中打包加入SQL数据库驱动并允许在安装程序服务器端时安装SQL数据库 这样可以不需要实施人员或客户单独安装SQL数据库程序

unit Myfuctions;

interface

uses
  SysUtils,windows,Dialogs,TlHelp32;

function Formatfilelink(str:string):string;
function hostname:string;
function Getpid(name:string):dword;
function getpexefile(WinProcessId  : LongWord):string;

implementation

function Formatfilelink(str:string):string;
var
buf: array[0..255] of char;
p:string;
begin
  getwindowsdirectory(buf,256);
  p:=Paramstr(0);
  str:=StringReplace(str,'$SD',ExtractFileDrive(buf),[rfReplaceAll]); //系统盘
  str:=StringReplace(str,'$SS',buf,[rfReplaceAll]); //系统目录
  str:=StringReplace(str,'$PD',ExtractFileDrive(p),[rfReplaceAll]); //程序所在盘
  str:=StringReplace(str,'$PP',ExtractFilePath(p),[rfReplaceAll]); //程序所在目录
  str:=StringReplace(str,'$PJ',p,[rfReplaceAll]); //程序路径
  Result:=STR;
end;

function hostname:string;
var
 tmpstr: PChar;
 Len : ^DWord;
begin
  GetMem(tmpstr,255);
  New(Len);
  Len^:= 255;
  if GetComputerName(tmpstr,Len^) then
    result:= StrPas(tmpstr)
  else
    result:='Unkown Host';
  FreeMem(tmpstr,255);
  Dispose(Len);
end;

function Getpid(name:string):dword;
var
 ProcessSnapShotHandle: THandle;
 ProcessEntry: TProcessEntry32;
 Ret: BOOL;
begin
 result:=0;
 ProcessSnapShotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 if ProcessSnapShotHandle>0 then
 begin
   ProcessEntry.dwSize:=SizeOf(TProcessEntry32);
   Ret:=Process32First(ProcessSnapShotHandle, ProcessEntry);
   while Ret do
   begin
     if ProcessEntry.szExeFile=name then
     begin
       result:=ProcessEntry.th32ProcessID;
       //result:=OpenProcess(PROCESS_ALL_ACCESS,False,ProcessEntry.th32ProcessID);
       exit;
     end;
     Ret:=Process32Next(ProcessSnapShotHandle, ProcessEntry)
   end;
   CloseHandle(ProcessSnapShotHandle)
 end
end;

function getpexefile(WinProcessId  : LongWord):string;
var
  ModuleStruct  : TMODULEENTRY32; // 模块信息结构
  ModuleHandle  : LongWord;       // 快照句柄
  FoundModule   : Boolean ;       // 是否找到模块
begin
  {---模块列表快照---}
  ModuleHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, WinProcessId);
  ModuleStruct.dwSize := sizeof(ModuleStruct);
  {----第1个模块----}
  FoundModule := Module32First(ModuleHandle, ModuleStruct);
  while (FoundModule) do
  begin
    result:=ModuleStruct.szExePath;
    {----是否后缀exe----}
    if ExtractFileExt(result)='.exe' then
      begin
        Break;
      end;
    {----下一个模块----}
    FoundModule := Module32Next(ModuleHandle, ModuleStruct);
  end;
  CloseHandle(ModuleHandle);
end;

end.