d_str32.pas

Motorola 集群通信系统中SDTS车载台PEI端测试程序

unit D_Str32;

interface

type
  Str8 = string[8];
  {$IFOPT N+}
   Float = Extended;
  {$ELSE}
   Float = Real;
  {$ENDIF}

function RemoveS2pComments(s : string) : string;

function Sign2Str(R : Float) : string;
  {-Convert a sign to a string}
function Float2EngUnit(x : float; Digits : integer; dtUnit : string) : String;

function Real2Eng(x: Float; Digits:word; PreFixMode : boolean): string;

function LeftPad(S : string; Len : Byte) : string;
  {-Return a string left-padded to length len with blanks}

function LeftPadChar(S : string; Len : Byte; ch : char) : string;
  {-Return a string left-padded to length len with CH}

function Left2Pad(S : string; Len : Byte) : string;
  {-Return a string left-padded to length len with Double blanks}

function Cut(S : string; Len : Byte) : string;
  {-Return a string truncated to length len}

function Pad(S : string; Len : Byte) : string;
  {-Return a string right-padded to length len with blanks}

function PadChar(S : string; Len : Byte; ch : char) : string;
  {-Return a string right-padded to length len with CH}

function Long2Str(L : LongInt) : string;
  {-Convert a longint/word/integer/byte/shortint to a string}

function Real2Str(R : Float; Width, Places : Byte) : string;
  {-Convert a real to a string}

function Str2Word(S : string; var I : Word) : Boolean;
  {-Convert a string to a word, returning true if successful}

function JustFileName(s : string) : string;
  {- returns a clean filename with extension}

function JustExt(s : string) : string;
  {- returns a extension}

function StripFileNameExt(s : string) : string;
  {- returns a filename without extension}

function ExtractFileNameOnly(s : string) : string;
  {- returns a filename without extension}

function StUpCase(s : string) : string;
  {- returns an upcase string }

function Trim(S : string) : string;
  {-Return a string with leading and trailing white space removed}

function TrimLead(S : string) : string;
  {-Return a string with leading white space removed}

function Str2Int(S : string; var I : Integer) : Boolean;
  {-Convert a string to an integer, returning true if successful}

function Str2ShortInt(S : string; var I : ShortInt) : Boolean;
  {-Convert a string to a ShortInteger, returning true if successful}

function Str2Byte(S : string; var I : Byte) : Boolean;
  {-Convert a string to a byte, returning true if successful}

function Str2Long(S : string; var I : LongInt) : Boolean;
  {-Convert a string to an longint, returning true if successful}

function Str2Real(S : string; var R : Real) : Boolean;
  {-Convert a string to a real, returning true if successful}

function Str2Float(S : string; var F : Float) : Boolean;
  {-Convert a string to a float, returning true if successful}

function HexW(W : Word) : string;
  {-Return hex string for word}

function HexB(B : byte) : string;
  {-Return hex string for byte}

function HexChar(B : byte) : Char;
  {-Return hex Char for byte}

function HexStr2Word(S : string; var I : Word) : Boolean;
  {-Convert a hexstring to a word, returning true if successful}

function HexChar2Byte(ch : char; var  b : byte) : boolean;

function HexChr2Byte(ch : char): byte;

function TabStr2SpaceStr(s : string;TabWidth : integer) : string;

function GetShortFileName(Const FileName : String) : String;

function GetLongFileName(Const FileName : String) : String;

function ShortToLongFileName(const ShortName: string): string;
(****************
function  FileExists(s : PChar) : boolean;

function HexB(B : Byte) : string;
  {-Return hex string for byte}

function HexL(L : LongInt) : string;
  {-Return hex string for longint}

function HexStr2Word(S : string; var I : Word) : Boolean;
  {-Convert a hexstring to a word, returning true if successful}

function TrimLead(S : string) : string;
  {-Return a string with leading white space removed}

function TrimTrail(S : string) : string;
  {-Return a string with trailing white space removed}

function Center(S : string; Width : Byte) : string;
  {-Return a string centered in a blank string of specified width}
****************)
implementation

uses
  SysUtils, Windows, ShellApi;
type
  Long =
    record
      LowWord, HighWord : Word;
    end;

const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';

const
  EngNotCiffers : byte = 11;
  EngNotMode    : boolean = True;
  PrFix         : array[-6..4] of string[2] =
                  (' a',' f',' p',' n',' u',' m','  ',' k',' M',' G',' T');

function ShortToLongFileName(const ShortName: string): string;
var
  Temp: TWin32FindData;
  SearchHandle: THandle;
begin
  SearchHandle := FindFirstFile(PChar(ShortName), Temp);
  if SearchHandle <> INVALID_HANDLE_VALUE then begin
    Result := string(Temp.cFileName);
    if Result = '' then Result := string(Temp.cAlternateFileName);
  end
  else Result := '';
  Windows.FindClose(SearchHandle);
end;

Function GetShortFileName(Const FileName : String) : String;
var
  aTmp: array[0..255] of char;
begin
  if GetShortPathName(PChar(FileName),aTmp,Sizeof(aTmp)-1)=0 then
     Result:= FileName
  else
     Result:=StrPas(aTmp);
end;

Function GetLongFileName(Const FileName : String) : String;
var
  aInfo: TSHFileInfo;
begin
  if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
     Result:= String(aInfo.szDisplayName)
  else
     Result:= FileName;
end;

function RemoveS2pComments(s : string) : string;
var
  n : integer;
begin
  n := Pos('!',s);
  if n > 0 then begin
    Result := Trim(copy(s,1,n-1));
  end
  else
    Result := s;
end;

function TabStr2SpaceStr(s : string;TabWidth : integer) : string;
var
  s1 : string;
begin
  if Pos(#9,s) = 0 then begin
    Result := s;
    Exit;
  end
  else
    Result := '';
  while Pos(#9,s) > 0 do begin
    s1 := Copy(s,1,Pos(#9,s)-1);
    Result := Result + Pad(Trim(s1),TabWidth);
    Delete(s,1,Pos(#9,s));
  end;
  Result := Result + s;
end;

function Sign2Str(R : Float) : string;
  {-Convert a sign to a string}
begin
  if R < 0 then
    Result := '-'
  else
    Result := '+';
end;

function Float2EngUnit(x : float; Digits : integer; dtUnit : string) : String;
const
  PrFix : array[-6..4] of string[2] = (' a',' f',' p',' n',' u',' m','  ',' k',' M',' G',' T');
var
  s,s1,s2 : string;
  k,m,Exponent : integer;
  Corr : integer;
begin
  if Digits < 3 then
    Digits := 3;
  s := Format('%.'+IntToStr(Digits)+'e',[x]);
  if s[1] = '-' then
    Corr := 1
  else
    Corr := 0;
  Delete(s,2+Corr,1); { delete '.'  }
  s1 := copy(s,1,Digits+Corr);
  s2 := copy(s,Pos('E',s)+1,1)+s[Pred(length(s))]+s[length(s)];
  Exponent := StrToInt(s2);
  k := Exponent+99;
  m := k - (k DIV 3)*3;
  Exponent := k-m-99;
  Insert('.',s1,m+2+Corr);
  if dtUnit = '' then begin
    if Exponent = 0 then
      s2 := ''
    else
      s2 := 'E'+IntToStr(Exponent);
  end
  else begin
    s2 := PrFix[Exponent DIV 3]+dtUnit;
  end;
  result := s1+s2;
end;

procedure EngNot(z : Float; var s : string; Ciffers : byte; PreFixMode: boolean);
var
  exponent,errcode,count : integer;
  t : string;
begin
  {$IFDEF N+}
  if ciffers < 11 then ciffers := 11;
  {$ELSE}
  if ciffers < 9 then ciffers := 9;
  {$ENDIF}
  count := 0;
  repeat
    Str(z:11,s);
    t := Copy(s,10,2);
    Val(t,exponent,errcode);
    if exponent mod 3 <> 0 then begin
      z := z / 10;
      inc(count);
    end;
  until exponent mod 3 = 0;
  Str(z:ciffers,s);
  Delete(s,3,1);
  Insert('.',s,count + 3);
  {$IFOPT N+}
  Delete(s,ciffers - 3,2);
  {$ENDIF}
  if s[1] <> '-' then
    Delete(s,1,1);
  if PrefixMode then begin
    t := Copy(s,Length(s) - 2,3);
    if t[1] = '+' then
      Delete(t,1,1);
    Val(t,exponent,errcode);
    if (exponent >= -18) and (exponent <= 12) then begin
      Delete(s,Length(s) - 3,4);
      s := s + PrFix[exponent div 3];
    end;
  end;
end;

function Real2Eng(x: Float; Digits:word; PreFixMode : boolean): string;
var
  tpStr: string;
begin
  EngNot(x,tpStr,Digits,PreFixMode);
  Real2Eng := tpStr;
end;


function JustFileName(s : string) : string;
begin
  while (Pos('\',s) + Pos(':',s)) > 0 do begin
    delete(s,1,1);
  end;
  JustFileName := s;
end;

function JustExt(s : string) : string;
begin
  while Pos('.',s) > 0 do begin
    delete(s,1,1);
  end;
  JustExt := s;
end;

function StripFileNameExt(s : string) : string;
begin
  while Pos('.',s) > 0 do begin
    delete(s,Length(s),1);
  end;
  StripFileNameExt := s;
end;

function ExtractFileNameOnly(s : string) : string;
begin
  s := JustFileName(s);
  while Pos('.',s) > 0 do
    SetLength(S,Length(s)-1);
  Result := s;
end;

function StUpCase(s : string) : string;
  {- returns an upcase string }
var
  n : byte;
  s1 : string;
begin
  s1 := '';
  for n := 1 to Length(s) do
    s1 := s1 + UpCase(s[n]);
  StUpCase := s1;
end;

function HexChar2Byte(ch : char; var  b : byte) : boolean;
var
  n : byte;
begin
  b := 16;