utchpublicfun.pas

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

  hDevice: THandle;
  cbBytesReturned: DWORD;
  pInData: PSendCmdInParams;
  pOutData: Pointer; // PSendCmdOutParams
  Buffer: Array[0..BufferSize - 1] of Byte;
  srbControl: TSrbIoControl absolute Buffer;

  procedure ChangeByteOrder(var Data; Size: Integer);
  var
    Ptr: PChar;
    I: Integer;
    C: Char;
  begin
    Ptr := @Data;
    for I := 0 to (Size Shr 1) - 1 do
    begin
      C := Ptr^;
      Ptr^ := (Ptr + 1)^;
      (Ptr + 1)^ := C;
      Inc(Ptr, 2);
    end;
  end;

begin
  Result := '';
  FillChar(Buffer, BufferSize, #0);
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  // Windows NT, Windows 2000
  begin
    // Get SCSI port handle
    hDevice := CreateFile('\\.\Scsi0:',
      GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE,
      Nil, OPEN_EXISTING, 0, 0);
    if hDevice = INVALID_HANDLE_VALUE then
      Exit;
    try
      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
      System.Move('SCSIDISK', srbControl.Signature, 8);
      srbControl.Timeout := 2;
      srbControl.Length := DataSize;
      srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
      pInData := PSendCmdInParams(PChar(@Buffer)
        + SizeOf(SRB_IO_CONTROL));
      pOutData := pInData;
      with pInData^ do
      begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do
        begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT,
        @Buffer, BufferSize, @Buffer, BufferSize,
        cbBytesReturned, Nil) then
        Exit;
    finally
      CloseHandle(hDevice);
    end;
  end
  else
  // Windows 95 OSR2, Windows 98
  begin
    hDevice := CreateFile('\\.\SMARTVSD', 0, 0, Nil,
      CREATE_NEW, 0, 0);
    if hDevice = INVALID_HANDLE_VALUE then
      Exit;
    try
      pInData := PSendCmdInParams(@Buffer);
      pOutData := @pInData^.bBuffer;
      with pInData^ do
      begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do
        begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA,
        pInData, SizeOf(TSendCmdInParams) - 1, pOutData,
        W9xBufferSize, cbBytesReturned, Nil) then
        Exit;
    finally
      CloseHandle(hDevice);
    end;
  end;
  with PIdSector(PChar(pOutData) + 16)^ do
  begin
    ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
    SetString(Result, sSerialNumber, SizeOf(sSerialNumber));
  end;
end;

///////////////////////////////////////////////////////////////////////////////
//语法：SendKeys(S: String);
//说明：模仿键盘按下某键
//参数：S
procedure SendKeys(S: String);
var
  I: Integer;
  Flag: Bool;
  W: Word;
  procedure SimulateKeyDown(Key: Byte);
  begin
    KeyBd_Event(Key, 0, 0, 0);
  end;
  procedure SimulateKeyUp(Key: Byte);
  begin
    KeyBd_Event(Key, 0, KEYEVENTF_KEYUP, 0);
  end;
  procedure SimulateKeystroke(Key: Byte; Extra: DWORD);
  begin
    KeyBd_Event(Key, Extra, 0, 0);
    KeyBd_Event(Key, Extra, KEYEVENTF_KEYUP, 0);
  end;
begin
  //获得大小写状态
  Flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
  //如果打下，必须转换为小写
  if Flag then
    SimulateKeystroke(VK_CAPITAL, 0);
  for I := 1 to Length(S) do
  begin
    W := VkKeyScan(S[I]);
    //如果键码转换错误
    if ((HiByte(W) <> $FF) and (LoByte(W) <> $FF)) then
    begin
      //如果需要SHIFT,保持起Down
      if HiByte(W) and 1 = 1 then
        SimulateKeyDown(VK_SHIFT);
      {Send the VK_KEY}
      SimulateKeystroke(LoByte(W), 0);
      {If the key required the shift key down - release it}
      if HiByte(W) and 1 = 1 then
        SimulateKeyUp(VK_SHIFT);
    end;
  end;
  {if the caps lock key was on at start, turn it back on}
  if Flag then
    SimulateKeystroke(VK_CAPITAL, 0);
end;

////////////////////////////////////////////////////////////////////////////
//语法：WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
// Text: String; Alignment: TAlignment; ARightToLeft: Boolean);
//说明：在Canvas上设定区域(ARect)内根据显示设置来显示字符串文字
//参数：Acanvas
//参数：Arect
//参数：DX
//参数：DY
//参数：Text
//参数：Alignment
//参数：ARightToLeft
//先声明DrawBitmap变量；该函数调用Semi函数。
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
  Text: String; Alignment: TAlignment; ARightToLeft: Boolean);
const
  AlignFlags: Array[TAlignment] of Integer =
  (DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
  RTL: Array[Boolean] of Integer = (0, DT_RTLREADING);
var
  B, R: TRect;
  Hold, Left: Integer;
  I: TColorRef;
  S: String;
  W, Y, H: Integer;
  DrawBitmap:TBitmap;
begin
  S := Semi(Text, #27);
  H := ACanvas.TextHeight(S);
  Y := (ARect.Bottom - ARect.Top - DY - DY - H) div 2;
  W := Acanvas.TextWidth(S);
  if W > Arect.Right - Arect.Left then
    Y := 0;
  I := ColorToRGB(ACanvas.Brush.Color);
  if GetNearestColor(ACanvas.Handle, I) = I then
  begin { Use ExtTextOut for solid colors }
    { In BiDi, because we changed the window origin, the text that does not
      change alignment, actually gets its alignment changed. }
    if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
      ChangeBiDiModeAlignment(Alignment);
    if Y = 0 then
    begin
      I := Length(S);
      while I > 0 do
      begin
        if ACanvas.TextWidth(Copy(S, 1, I)) <= Arect.Right - Arect.Left then
          break;
        if Ord(S[I]) > 160 then
          Dec(I);
        Dec(I);
      end;
      W := ACanvas.TextWidth(Copy(S, 1, I));
      case Alignment of
        taLeftJustify:
          Left := ARect.Left + DX;
        taRightJustify:
          Left := ARect.Right - W - 3;
      else { taCenter }
        Left := ARect.Left + (ARect.Right - ARect.Left) shr 1 - (W shr 1);
      end;
      ACanvas.TextRect(ARect, Left, ARect.Top + DY, Copy(S, 1, I));
      W := ACanvas.TextWidth(Copy(S, I + 1, 65535));
      case Alignment of
        taLeftJustify:
          Left := ARect.Left + DX;
        taRightJustify:
          Left := ARect.Right - W - 3;
      else { taCenter }
        Left := ARect.Left + (ARect.Right - ARect.Left) shr 1 - (w shr 1);
      end;
      Inc(ARect.Top, H + DY + DY);
      ACanvas.TextRect(ARect, Left, ARect.Top + DY, Copy(S, I + 1, 65535));
      Dec(ARect.Top, H + DY + DY);
    end
    else
    begin
      case Alignment of
        taLeftJustify:
          Left := ARect.Left + DX;
        taRightJustify:
          Left := ARect.Right - W - 3;
      else { taCenter }
        Left := ARect.Left + (ARect.Right - ARect.Left) shr 1 - (W shr 1);
      end;
      ACanvas.TextRect(ARect, Left, ARect.Top + DY + Y, Copy(S, 1, I));
    end;
  end
  else
  begin { Use FillRect and Drawtext for dithered colors }
    DrawBitmap.Canvas.Lock;
    try
      with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
      begin { brush origin tics in painting / scrolling.    }
        Width := Max(Width, Right - Left);
        Height := Max(Height, Bottom - Top);
        R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
        B := Rect(0, 0, Right - Left, Bottom - Top);
      end;
      with DrawBitmap.Canvas do
      begin
        Font := ACanvas.Font;
        Font.Color := ACanvas.Font.Color;
        Brush := ACanvas.Brush;
        Brush.Style := bsSolid;
        FillRect(B);
        SetBkMode(Handle, TRANSPARENT);
        if (ACanvas.CanvasOrientation = coRightToLeft) then
          ChangeBiDiModeAlignment(Alignment);
        DrawText(Handle, PChar(Text), Length(Text), R,
          AlignFlags[Alignment] or RTL[ARightToLeft]);
      end;
      if (ACanvas.CanvasOrientation = coRightToLeft) then
      begin
        Hold := ARect.Left;
        ARect.Left := ARect.Right;
        ARect.Right := Hold;
      end;
      ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
    finally
      DrawBitmap.Canvas.Unlock;
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////
//语法：ExtractRes(ResType, ResName, ResNewName: String): Boolean;
//说明：从资源文件中提取资源。
//参数：ResType
//参数：ResName
//参数：ResNewName
function ExtractRes(ResType, ResName, ResNewName: String): Boolean;
var
  Res: TResourceStream;
begin
  try
    Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
    try
      Res.SavetoFile(ResNewName);
      Result := True;
    finally
      Res.Free;
    end;
  except
    Result := False;
  end;
end;

//////////////////////////////////////////////////////////////////////////////
//语法：GetIP: String;
//说明：获取最后一个IP地址的字符串，一般是拨号后动态分配的IP地址。如果主机还未拨号上网，则返回的是本地局域网的IP地址。
//参数：
function GetIP: String;
var
  WSAData: TWSAData;
  HostName: Array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  HostEnt: PHostEnt;
  LastIP: PInAddr;
  IPList: ^PInAddr;
begin
  Result := '';
  if 0 = WSAStartup(MAKEWORD(1, 1), WSAData) then
  try
    if 0 = GetHostName(HostName, MAX_COMPUTERNAME_LENGTH + 1) then
    begin
      HostEnt := GetHostByName(HostName);
      if HostEnt <> Nil then
      begin
        IPList := Pointer(HostEnt^.H_Addr_List);
        repeat
          LastIP := IPList^;
          INC(IPList);
        until IPList^ = Nil;
        if LastIP <> Nil then
          Result := Inet_ntoa(LastIP^);
      end;
    end;
  finally
    WSACleanup;
  end;
end;

////////////////////////////////////////////////////////////////////////////
function GetBootedTime: Real;
///获取Windows启动后经过的时间(分钟)
begin
   Result:=Int(GetTickCount/1000/60);
end;


///////////////////////////////////////////////////////////////////////
procedure About;
//显示Windows关于对话框
begin
   ShellAbout(Application.Handle, PChar(application.MainForm.Caption), '',Application.Icon.Handle );
end;


////////////////////////////////////////////////////////////////////////////
function GetAppPath:String;
//返回当前程序的目录
begin
   Result:=ExtractFilePath(Application.ExeName);
   if Result[Length(Result)]<>'\' then Result := Result + '\';
end;
//////////////////////////////////////////////////////////////////////////

function GetAppName: String;
//获取当前程序的文件名(带路径)
begin
  Result:=Application.ExeName;
end;


/////////////////////////////////////////////////////////////////////////
procedure MyMsg(Msg: String);
//显示提示信息框
begin
   Application.MessageBox(PChar(Msg),'信息',
                          MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
end;


////////////////////////////////////////////////////////////////////////////
//说明:选择排序
//参数:
//1.aList 要排序的数据的指针列表
//2.aFirst 列表中要排序的起始位置
//3.aLast 列表中要排序的结束位置
//4.aCompare 排序时的比较大小的比较函数
procedure SelectionSort(aList    : TList;
                          aFirst   : integer;
                          aLast    : integer;
                          aCompare : TtdCompareFunc);
var
  i, j       : integer;
  IndexOfMin : integer;
  Temp       : pointer;
begin
  for i := aFirst to pred(aLast) do begin
    IndexOfMin := i;
    for j := succ(i) to aLast do
      if (aCompare(aList.List^[j], aList.List^[IndexOfMin]) < 0) then
        IndexOfMin := j;
    Temp := aList.List^[i];
    aList.List^[i] := aList.List^[IndexOfMin];
    aList.List^[IndexOfMin] := Temp;
  end;
end;

////////////////////////////////////////////////////////////////////////////
//说明:插入排序
//参数:
//1.aList 要排序的数据的指针列表
//2.aFirst 列表中要排序的起始位置
//3.aLast 列表中要排序的结束位置
//4.aCompare 排序时的比较大小的比较函数
procedure InsertionSortStd(aList    : TList;
                             aFirst   : integer;
                             aLast    : integer;
                             aCompare : TtdCompareFunc);
var
  i, j : integer;
  Temp : pointer;
begin
  for i := succ(aFirst) to aLast do begin
    Temp := aList.List^[i];
    j := i;
    while (j > aFirst) and
          (aCompare(Temp, aList.List^[j-1]) < 0) do begin
      aList.List^[j] := aList.List^[j-1];
      dec(j);
    end;
    aList.List^[j] := Temp;
  end;
end;



end.