covertfuncs.pas

用于CD/DVD烧录的Delphi源码,包括source和demo

{$WARN SYMBOL_DEPRECATED OFF}
{$WARN SYMBOL_PLATFORM OFF}

{-----------------------------------------------------------------------------
 Unit Name: CovertFuncs
 Author:    Dancemammal
 Purpose:   Standard Functions
 History:
-----------------------------------------------------------------------------}

unit CovertFuncs;

interface

uses Windows, SysUtils, Classes, DeviceTypes, Math, TypInfo, ScsiDefs,
scsitypes;

const
  OS_UNKNOWN = -1;
  OS_WIN95 = 0;
  OS_WIN98 = 1;
  OS_WINNT35 = 2;
  OS_WINNT4 = 3;
  OS_WIN2K = 4;
  OS_WINXP = 5;

  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;

type
  TCharArr = array of Char;

type
  TBothEndianWord = packed record
    LittleEndian,
      BigEndian: Word;
  end;

  TBothEndianDWord = packed record
    LittleEndian,
      BigEndian: LongWord;
  end;

type
  TVolumeDateTime = packed record
    Year: array[0..3] of Char;
    Month: array[0..1] of Char;
    Day: array[0..1] of Char;
    Hour: array[0..1] of Char;
    Minute: array[0..1] of Char;
    Second: array[0..1] of Char;
    MSeconds: array[0..1] of Char;
    GMTOffset: Byte;
  end;

type
  TDirectoryDateTime = packed record
    Year: Byte; // since 1900
    Month: Byte;
    Day: Byte;
    Hour: Byte;
    Minute: Byte;
    Second: Byte;
    GMTOffset: Byte; // in 15 minutes steps
  end;

function EnumToStr(ArgType: PTypeInfo; var Arg): string;
function SetToStr(ArgType: PTypeInfo; var Arg): string;
function HexToStrings(Buf: pointer; BufLen: DWORD): TStrings;
function Swap32(value: dword): dword;

function ConvertDataBlock(DataBlock: Integer): Integer;
function GetFileSize(const FileName: string): LongInt;
procedure ZeroMemory(Destination: Pointer; Length: DWORD);
function getOsVersion: integer;
function RoundUp(X: Extended): Integer;
function ArrOfChar(AStr: string): TCharArr;

function IntToMB(const ASize: Int64): string;
function VolumeDateTimeToStr(const VDT: TVolumeDateTime): string;
function SwapWord(const AValue: Word): Word;
function SwapDWord(const AValue: LongWord): LongWord;
function BuildBothEndianWord(const AValue: Word): TBothEndianWord;
function BuildBothEndianDWord(const AValue: LongWord): TBothEndianDWord;
function BuildDirectoryDateTime(const ADateTime: TDateTime; const AGMTOffset:
  Byte): TDirectoryDateTime;
function BuildVolumeDateTime(const ADateTime: TDateTime; const AGMTOffset:
  Byte): TVolumeDateTime;
function RetrieveFileSize(const AFileName: string): LongWord;
function IsAdministrator: Boolean;
function Endian(const Source; var Destination; const Count: Integer): Boolean;
function EndianToIntelBytes(const AValue: array of Byte; Count: Byte): Integer;
function GetLBA(const Byte1, Byte2, Byte3, Byte4: Byte): LongWord;
function HMSFtoLBA(const AHour, AMinute, ASecond, AFrame: Byte): LongWord;
function LBA2HMSF(LBA: Integer): string;
Procedure LBA2MSF(Const LBA: Integer; Var Min, Sec, Frame :Integer);
function LBA2MB(LBA, BlockSize: DWord): DWord;
function LBA2PreCDDB(LBA: Integer): Integer;
function SectorPos2TimePos(SectorPos : longint) : longint;
function TimePos2SectorPos(Min, Sec, Frame : longint) : longint;
function HiWord(Lx: LongWord): Word;
function LoWord(Lx: LongWord): Word;
function HiByte(Lx: Word): Byte;
function LoByte(Lx: Word): Byte;
function IsBitSet(const Value: LongWord; const Bit: Byte): Boolean;
function BitOn(const Value: LongWord; const Bit: Byte): LongWord;
function BitOff(const Value: LongWord; const Bit: Byte): LongWord;
function BitToggle(const Value: LongWord; const Bit: Byte): LongWord;
function ByteToBin(Value: Byte): string;
function ScsiErrToString(Err: TScsiError): string;
function UnicodeToStr(Name: string): String;
function StrToUnicode(Name: string): PWideChar;
function DOSchars_Len(str: string; Sze: integer): string;
function GetISOFilename(const FileName: string): string;

function BigEndianW(Arg: WORD): WORD;
function BigEndianD(Arg: DWORD): DWORD;
procedure BigEndian(const Source; var Dest; Count: integer);
function GatherWORD(b1, b0: byte): WORD;
function GatherDWORD(b3, b2, b1, b0: byte): DWORD;
procedure ScatterDWORD(Arg: DWORD; var b3, b2, b1, b0: byte);
procedure ASPIstrCopy(Src: PChar; var Dst: ShortString; Leng: Integer);

function CDDB_Sum(N: Integer): Integer;



implementation

function getOsVersion: integer;
var
  os: OSVERSIONINFO;
begin
  ZeroMemory(@os, sizeof(os));
  os.dwOSVersionInfoSize := sizeof(os);
  GetVersionEx(os);

  if os.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    if (os.dwMajorVersion = 3) and (os.dwMinorVersion >= 51) then
    begin
      Result := OS_WINNT35;
      Exit;
    end
    else if os.dwMajorVersion = 4 then
    begin
      Result := OS_WINNT4;
      Exit;
    end
    else if (os.dwMajorVersion = 5) and (os.dwMinorVersion = 0) then
    begin
      Result := OS_WIN2K;
      Exit;
    end
    else
    begin
      Result := OS_WINXP;
      Exit;
    end;
  end
  else if os.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
  begin
    if os.dwMinorVersion = 0 then
    begin
      Result := OS_WIN95;
      Exit;
    end
    else
    begin
      Result := OS_WIN98;
      Exit;
    end;
  end;

  Result := OS_UNKNOWN;
end;

function BigEndianW(Arg: WORD): WORD;
begin
  result := ((Arg shl 8) and $FF00) or
    ((Arg shr 8) and $00FF);
end;

function BigEndianD(Arg: DWORD): DWORD;
begin
  result := ((Arg shl 24) and $FF000000) or
    ((Arg shl 8) and $00FF0000) or
    ((Arg shr 8) and $0000FF00) or
    ((Arg shr 24) and $000000FF);
end;

procedure BigEndian(const Source; var Dest; Count: integer);
var
  pSrc, pDst: PChar;
  i: integer;
begin
  pSrc := @Source;
  pDst := PChar(@Dest) + Count;
  for i := 0 to Count - 1 do
  begin
    Dec(pDst);
    pDst^ := pSrc^;
    Inc(pSrc);
  end;
end;

function GatherWORD(b1, b0: byte): WORD;
begin
  result := ((WORD(b1) shl 8) and $FF00) or
    ((WORD(b0)) and $00FF);
end;

{$WARNINGS OFF}

function GatherDWORD(b3, b2, b1, b0: byte): DWORD;
begin
  result := ((LongInt(b3) shl 24) and $FF000000) or
    ((LongInt(b2) shl 16) and $00FF0000) or
    ((LongInt(b1) shl 8) and $0000FF00) or
    ((LongInt(b0)) and $000000FF);
end;
{$WARNINGS ON}

procedure ScatterDWORD(Arg: DWORD; var b3, b2, b1, b0: byte);
begin
  b3 := (Arg shr 24) and $FF;
  b2 := (Arg shr 16) and $FF;
  b1 := (Arg shr 8) and $FF;
  b0 := Arg and $FF;
end;

procedure ASPIstrCopy(Src: PChar; var Dst: ShortString; Leng: Integer);
var
  i: integer;
begin
  i := 0;
  while (i < Leng) and (Src[i] >= ' ') do
  begin
    Dst[i + 1] := Src[i];
    inc(i);
  end;
  while (i > 0) and (Dst[i] = ' ') do
    Dec(i); // Trim it Right
  Dst[0] := CHR(i);
end;

function Swap32(value: dword): dword;
  assembler;
asm
   bswap eax
end;


function UnicodeToStr(Name: string): String;
var
  i: integer;
  ResString : String;
begin
  i := 0;
  ResString := '';
  For I := 0 to length(Name) do
     if Name[i] <> #0 then ResString := ResString + Name[i];
  Result := ResString;
end;


function StrToUnicode(Name: string): PWideChar;
var
  WideChr: PWideChar;
  Size: Integer;
begin
  Size := (length(Name) + 1) * 2;
  WideChr := PWideChar(StrAlloc(Size)); //important
  StringToWideChar(Name, WideChr, Size + 1);
  Result := WideChr;
end;

function DOSchars_Len(str: string; Sze: integer): string;
//filters out non DOS chars, max length = Sze, including extension
var
  temp: string;
  i: integer;
begin
  result := ''; //important
  temp := UpperCase(str);
  if Pos('.', temp) > 0 then
  begin
    result := DOSchars_Len(Copy(temp, 1, Pos('.', temp) - 1), Sze - 4) +
      Copy(temp, Pos('.', temp), 4);
    exit;
  end;
  for i := 1 to length(temp) do
    if temp[i] in ['0'..'9', 'A'..'Z', '_'] then
      result := result + temp[i];
  result := Copy(result, 1, Sze);
end;

procedure ZeroMemory(Destination: Pointer; Length: DWORD);
begin
  FillChar(Destination^, Length, 0);
end;

function EnumToStr(ArgType: PTypeInfo; var Arg): string;
begin
  case (GetTypeData(ArgType))^.OrdType of
    otSByte, otUByte: Result := GetEnumName(ArgType, BYTE(Arg));
    otSWord, otUWord: Result := GetEnumName(ArgType, WORD(Arg));
    otSLong: Result := GetEnumName(ArgType, LongInt(Arg));
  end;
end;

function ScsiErrToString(Err: TScsiError): string;
begin
  Result := EnumToStr(TypeInfo(TScsiError), Err);
end;

type
  TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
  PIntegerSet = ^TIntegerSet;

function SetToStr(ArgType: PTypeInfo; var Arg): string;
var
  Info: PTypeInfo;
  Data: PTypeData;
  I: Integer;
begin
  Result := '[';
  Info := (GetTypeData(ArgType))^.CompType^;
  Data := GetTypeData(Info);
  for I := Data^.MinValue to Data^.MaxValue do
    if I in PIntegerSet(@Arg)^ then
    begin
      if Length(Result) <> 1 then
        Result := Result + ', ';
      Result := Result + GetEnumName(Info, I);
    end;
  Result := Result + ']';
end;

{$WARNINGS OFF}

function HexToStrings(Buf: pointer; BufLen: DWORD): TStrings;
const
  BytesPerLine = 16;
  BytesPerTab = 4;
  CharsInAddress = 4;
var
  CurLine, CurByte, CurOffset: integer;
  s: string;
  b: char;
begin
  Result := TStringList.Create;
  if (BufLen <= 0) or not Assigned(Buf) then
    exit;
  try
    for CurLine := 0 to (BufLen - 1) div BytesPerLine do
    begin
      CurOffset := CurLine * BytesPerLine;
      s := IntToHex(CurOffset, CharsInAddress);
      for CurByte := 0 to BytesPerLine - 1 do
      begin
        if (CurByte mod BytesPerTab) = 0 then
          s := s + ' ';
        if CurOffset < BufLen then
          s := s + IntToHex(BYTE((PChar(Buf) + CurOffset)^), 2) + ' '
        else
          s := s + '   ';
        Inc(CurOffset);
      end;
      s := s + '|';
      CurOffset := CurLine * BytesPerLine;
      for CurByte := 0 to BytesPerLine - 1 do
      begin
        if CurOffset < BufLen then
        begin
          b := (PChar(Buf) + CurOffset)^;
          if b < ' ' then
            b := ' ';
          s := s + b;
        end
        else
          s := s + ' ';
        Inc(CurOffset);
      end;
      Result.Add(s);
    end;
  except
    Result.Clear;
  end;
end;
{$WARNINGS ON}

function LBA2MB(LBA, BlockSize: DWord): DWord;
begin
  Result := ((LBA div 1024) * BlockSize) div 1024;
end;