utchpublicfun.pas

delphi底层函数delphi底层函数delphi底层函数delphi底层函数

  begin
    case Result of
      -2: ShowMessage('通讯端口已经被使用');
      -12: ShowMessage('通讯速率设置错误');
      -10: ShowMessage('通讯端口不存在');
    else
      ShowMessage('通讯端口打开错误，错误代码=' + Itos(Result));
    end;
    Exit;
  end;
  FlushComm(Result, 0);
  FlushComm(Result, 1);
  StrPCopy(Buf, Format('COM%d:%d,%s,%d,%d', [Port, Rate, Pe, Bits, Stop]));
  BuildCommDCB(Buf, Dcb);
  SetCommState(Dcb);
  EscapeCommFunction(Result, RESETDEV);
end;

/////////////////////////////////////////////////////////////////////////////
//语法：GetComm(Cid: Integer; Num: Integer): String;
//说明：
//参数：Cid
//参数：Num
//该函数调用ReadComm函数。
function GetComm(Cid: Integer; Num: Integer): String;
var
  Buf: Array[0..255] of char;
  N: Integer;
  Stat: TComStat;
begin
  N := ReadComm(Cid, Buf, Num);
  if N > 0 then
  begin
    Buf[N] := #0;
    Result := StrPas(Buf);
    CommError := 0;
    Exit;
  end;
  CommError := GetCommError(Cid, Stat);
  Result := '';
end;
///////////////////////////////////////////////////////////////////////////
//语法：PutComm(Cid: Integer; St: String);
//说明：
//参数：Cid
//参数：St
procedure PutComm(Cid: Integer; St: String);
var
  Buf: Array[0..255] of char;
  Stat: TComStat;
begin
  StrPCopy(Buf, St);
  if WriteComm(Cid, Buf, Length(St)) < 0 then
    CommError := GetCommError(Cid, Stat)
  else
    CommError := 0;
end;
}


/////////////////////////////////////////////////////////////////////////
//语法：RegisterAxLib(FileName, Cmd: String);
//说明：
//参数：FileName
//参数：Cmd
type
  TRegProc = function: HResult; stdcall;

procedure RegisterAxLib(FileName, Cmd: String);
var
  LibHandle: THandle;
  RegProc: TRegProc;
begin
  LibHandle := LoadLibrary(PChar(FileName));
  if LibHandle = 0 then
    raise Exception.CreateFmt('动态库{%s}不存在！', [FileName]);
  try
    @RegProc := GetProcAddress(LibHandle, PChar(Cmd));
    if @RegProc = Nil then
      raise Exception.CreateFmt('{%s}之函数%s不存在！', [FileName, Cmd]);
    if RegProc <> 0 then
      raise Exception.CreateFmt('{%s}之{%s}命令执行失败！', [FileName, Cmd]);
  finally
    FreeLibrary(LibHandle);
  end;
end;

/////////////////////////////////////////////////////////////////
//语法：RunAtStartup(Key, Value: String);
//说明：把程序放到注册表的启动组里。
//参数：Key 注册表的键名
//参数：Value 运行程序的目录
procedure RunAtStartup(Key, Value: String);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', False);
  Reg.WriteString(Key, Value);
  Reg.Free;
end;



////////////////////////////////////////////////////////////////////////
//语法：Execute(Ln: Pchar; nShow: Integer);
//说明：运行可执行文件
//参数：Ln
//参数：nShow
procedure Execute(Ln: Pchar; nShow: Integer);
var
  StartInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
begin
  GetStartupInfo(StartInfo);
  StartInfo.dwFlags := STARTF_USESHOWWINDOW;     //wait_for_single_
  StartInfo.wShowWindow := nShow;
  if CreateProcess(Nil, PChar(Ln), Nil, Nil, false, 0, Nil, Nil, StartInfo,
    ProcInfo) = False
  then
    raise Exception.Create('不能执行程序 ' + Ln)
  else
    WaitForSingleObject(ProcInfo.hThread, INFINITE);
  closehandle(ProcInfo.hThread);
//  CloseHandle(StartInfo.);
  // Application.BringToFront;
end;

///////////////////////////////////////////////////////////////////////////////todo:
//语法：HideApp
//说明：隐藏程序。
//参数：
procedure HideApp;
type
  TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD;
    stdcall;
var
  Hndl: THandle;
  RegisterServiceProcess: TRegisterServiceProcess;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then   //不是NT
  begin
    Hndl := LoadLibrary('KERNEL32.DLL');
    RegisterServiceProcess := GetProcAddress(Hndl, 'RegisterServiceProcess');
    RegisterServiceProcess(GetCurrentProcessID, 1);
    //程序不出现在ALT+DEL+CTRL列表中
    SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
    //程序不出现在任务栏
    Application.ShowMainForm := False;
    //程序不出现主窗口
    FreeLibrary(Hndl);
  end
  else
  begin
    SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
    //程序不出现在任务栏
    Application.ShowMainForm := False;
    //程序不出现主窗口
  end;
end;

//////////////////////////////////////////////////////////////
//语法：CloseApp(ClassName: String): Boolean;
//说明：关闭外部应用程序。
//参数：ClassName
function CloseApp(ClassName: String): Boolean;
var
  Exehandle: THandle;
begin
  //ExeHandle := FindWindow(Nil, Pchar(Caption));
  ExeHandle := FindWindow(Pchar(ClassName), Nil);
  if ExeHandle <> 0 then
  begin
    PostMessage(ExeHandle, WM_Quit, 0, 0);
    Result := True;
  end
  else
  begin
    Result := False;
  end;
end;

//////////////////////////////////////////////////////////////////////////////////todo:
//语法：DeleteMe
//说明：程序自杀。
//参数：
procedure DeleteMe;
//程序自杀
   //-----------------------------------------------------------
   //转换长文件名
   function GetShortName(sLongName: string): string;
   var sShortName: string;
       nShortNameLen: integer;
   begin
      SetLength(sShortName, MAX_PATH);
      nShortNameLen := GetShortPathName(PChar(sLongName),
      PChar(sShortName), MAX_PATH - 1);
      if (0 = nShortNameLen) then
         begin
         //handle errors...
         end;
      SetLength(sShortName, nShortNameLen);
      Result := sShortName;
   end;
   //-------------------------------------------------
var
   BatchFile: TextFile;
   BatchFileName: string;
   ProcessInfo: TProcessInformation;
   StartUpInfo: TStartupInfo;
begin
   BatchFileName := ExtractFilePath(ParamStr(0)) + '$$a$$.bat';
   AssignFile(BatchFile, BatchFileName);
   Rewrite(BatchFile);
   Writeln(BatchFile, ':try');
   Writeln(BatchFile, 'del "' + GetShortName(ParamStr(0)) + '"');
   Writeln(BatchFile, 'if exist "' + GetShortName(ParamStr(0)) + '"' + ' goto try');
   Writeln(BatchFile, 'del %0');
   Writeln(BatchFile, 'cls');
   Writeln(BatchFile, 'exit');
   CloseFile(BatchFile);
   FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
   StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartUpInfo.wShowWindow := SW_Hide;
   if CreateProcess(nil, PChar(BatchFileName), nil, nil,
   False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
   ProcessInfo) then
      begin
         CloseHandle(ProcessInfo.hThread);
         CloseHandle(ProcessInfo.hProcess);
      end;
  // Application.Terminate;
end;

/////////////////////////////////////////////////////////////////////////
//语法：ExeExt(Ext: String): String;
//说明：获得更改后的应用程序的扩展名
//EX:   ExeExt('.txt') ---> '...Project1.txt'
//参数：Ext
function ExeExt(Ext: String): String;
var
  I: Word;
  S: String;
begin
  S := Application.ExeName;
  for I := Length(S) downto 1 do
  begin
    if S[I] = '.' then
    begin
      Result := Copy(S, 1, I - 1) + Ext;
      Exit;
    end;
  end;
  Result := '';
end;


//////////////////////////////////////////////////////////////////////////////todo:
//语法：RunDosInMemo(DosApp: String; ResList: TStringList);
//说明：在程序中执行Dos命令，并显示命令执行过程。
//参数：DosApp
//参数：ResList
procedure RunDosInMemo(DosApp: String; ResList: TStringList);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  Start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: Pchar;
  BytesRead: DWord;
  Apprunning: DWord;
begin
  with Security do
  begin
    Nlength := SizeOf(TSecurityAttributes);
    Binherithandle := True;
    Lpsecuritydescriptor := Nil;
  end;

  if Createpipe(ReadPipe, WritePipe, @Security, 0) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(Start, Sizeof(Start), #0);
    Start.cb := SizeOf(start);
    Start.hStdOutput := WritePipe;
    Start.hStdInput := ReadPipe;
    Start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    Start.wShowWindow := SW_HIDE;

    if CreateProcess(Nil,
      PChar(DosApp),
      @Security,
      @Security,
      True,
      NORMAL_PRIORITY_CLASS,
      Nil,
      Nil,
      Start,
      ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;
      until (Apprunning <> WAIT_TIMEOUT);
      repeat
        BytesRead := 0;
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        ResList.Text := ResList.text + string(Buffer);
      until (BytesRead < ReadBuffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

//////////////////////////////////////////////////////////////////////////////
//语法：GetDisks(Strings: TStringList);
//说明：获取所有盘符。
//参数：Strings
procedure GetDisks(Strings: TStringList);
const
  BufSize = 256;
var
  Buffer: PChar;
  P: PChar;
begin
  GetMem(Buffer, BufSize);
  try
    Strings.BeginUpdate;
    try
      Strings.Clear;
      if GetLogicalDriveStrings(BufSize, Buffer) <> 0 then
      begin
        P := Buffer;
        while P^ <> #0 do
        begin
          Strings.Add(P);
          Inc(P, StrLen(P) + 1);
        end;
      end;
    finally
      Strings.EndUpdate;
    end;
  finally
    FreeMem(Buffer, BufSize);
  end;
end;

/////////////////////////////////////////////////////////////////////////////
//语法：GetHdID: String;
//说明：获取Ide硬盘序列号。
//参数：
//执行内容：
function GetHdID: String;
type
  TSrbIoControl = packed record
    HeaderLength: ULONG;
    Signature: Array[0..7] of Char;
    Timeout: ULONG;
    ControlCode: ULONG;
    ReturnCode: ULONG;
    Length: ULONG;
  end;
  SRB_IO_CONTROL = TSrbIoControl;
  PSrbIoControl = ^TSrbIoControl;
  TIDERegs = packed record
    bFeaturesReg: Byte;     // Used for specifying SMART "commands".
    bSectorCountReg: Byte;  // IDE sector count register
    bSectorNumberReg: Byte; // IDE sector number register
    bCylLowReg: Byte;      // IDE low order cylinder value
    bCylHighReg: Byte;     // IDE high order cylinder value
    bDriveHeadReg: Byte;   // IDE drive/head register
    bCommandReg: Byte;     // Actual IDE command.
    bReserved: Byte;       // Reserved. Must be zero.
  end;
  IDEREGS = TIDERegs;
  PIDERegs = ^TIDERegs;
  TSendCmdInParams = packed record
    cBufferSize: DWORD;
    irDriveRegs: TIDERegs;
    bDriveNumber: Byte;
    bReserved: Array[0..2] of Byte;
    dwReserved: Array[0..3] of DWORD;
    bBuffer: Array[0..0] of Byte;
  end;
  SENDCMDINPARAMS = TSendCmdInParams;
  PSendCmdInParams = ^TSendCmdInParams;
  TIdSector = packed record
    wGenConfig: Word;
    wNumCyls: Word;
    wReserved: Word;
    wNumHeads: Word;
    wBytesPerTrack: Word;
    wBytesPerSector: Word;
    wSectorsPerTrack: Word;
    wVendorUnique: Array[0..2] of Word;
    sSerialNumber: Array[0..19] of Char;
    wBufferType: Word;
    wBufferSize: Word;
    wECCSize: Word;
    sFirmwareRev: Array[0..7] of Char;
    sModelNumber: Array[0..39] of Char;
    wMoreVendorUnique: Word;
    wDoubleWordIO: Word;
    wCapabilities: Word;
    wReserved1: Word;
    wPIOTiming: Word;
    wDMATiming: Word;
    wBS: Word;
    wNumCurrentCyls: Word;
    wNumCurrentHeads: Word;
    wNumCurrentSectorsPerTrack: Word;
    ulCurrentSectorCapacity: ULONG;
    wMultSectorStuff: Word;
    ulTotalAddressableSectors: ULONG;
    wSingleWordDMA: Word;
    wMultiWordDMA: Word;
    bReserved: Array[0..127] of Byte;
  end;
  PIdSector = ^TIdSector;
const
  IDE_ID_FUNCTION = $EC;
  IDENTIFY_BUFFER_SIZE = 512;
  DFP_RECEIVE_DRIVE_DATA = $0007C088;
  IOCTL_SCSI_MINIPORT = $0004D008;
  IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
  DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
  BufferSize = SizeOf(SRB_IO_CONTROL) + DataSize;
  W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
var