ststrz.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

function CenterChZ(Dest, S : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string centered in a string of C with specified width}
begin
  StrCopy(Dest, S);
  Result := CenterChPrimZ(Dest, C, Len);
end;

function CenterPrimZ(S : PAnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string centered in a blank string of specified width}
begin
  Result := CenterChPrimZ(S, ' ', Len);
end;

function CenterZ(Dest, S : PAnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string centered in a blank string of specified width}
begin
  StrCopy(Dest, S);
  Result := CenterPrimZ(Dest, Len);
end;

function ScramblePrimZ(S, Key : PAnsiChar) : PAnsiChar;
  {-Encrypt / Decrypt string with enhanced XOR encryption. This
    primitive version modifies the source string directly.}
var
  SPtr, KPtr, EndPtr : PAnsiChar;
begin
  Result := S;
  if Key^ = #0 then Exit;
  if S^ = #0 then Exit;
  SPtr := S;
  EndPtr := StrEnd(Key);
  Dec(EndPtr);
  KPtr := EndPtr;
  while SPtr^ <> #0 do begin
    if KPtr < Key then
      KPtr := EndPtr;
    if (SPtr^ <> KPtr^) then
      SPtr^ := Char(Byte(SPtr^) xor Byte(KPtr^));
    Inc(SPtr);
    Dec(KPtr);
  end;
end;

function ScrambleZ(Dest, S, Key : PAnsiChar) : PAnsiChar;
  {-Encrypt / Decrypt string with enhanced XOR encryption.}
begin
  StrCopy(Dest, S);
  Result := ScramblePrimZ(Dest, Key);
end;

function SubstituteZ(Dest, Src, FromStr, ToStr : PAnsiChar) : PAnsiChar;
  {-Return string S after mapping characters found in FromStr to the
    corresponding ones in ToStr}
var
  I : Cardinal;
  P : Cardinal;
  L : Cardinal;
begin
  StrCopy(Dest, Src);
  if StrLen(FromStr) = StrLen(ToStr) then begin
    L := StrLen(Dest);
    if L > 0 then
      for I := 0 to L-1 do begin
        if StrChPosZ(FromStr, Dest[I], P) then
          Dest[I] := ToStr[P];
      end;
  end;
  Result := Dest;
end;

function FilterZ(Dest, Src, Filters : PAnsiChar) : PAnsiChar;
  {-Return string S after removing all characters in Filters from it}
var
  I : Cardinal;
  Len : Cardinal;
  L : Cardinal;
begin
  Result := Dest;
  StrCopy(Dest, Src);
  Len := 0;
  L := StrLen(Dest);
  if L > 0 then
    for I := 0 to L-1 do
      if not CharExistsZ(Filters, Dest[I]) then begin
        Result[Len] := Dest[I];
        inc(Len);
      end;
  Result[Len] := #0;
end;

function EntabZ(Dest, Src : PAnsiChar; TabSize : Byte) : PAnsiChar;
  {-Convert blanks in a string to tabs on spacing TabSize}
register;
asm
  push   eax                { Save registers }
  push   ebx
  push   edi
  push   esi

  mov    edi, eax
  and    ecx, 0FFh          { zero all but low byte of ECX }
  jz     @@Done
  mov    esi, edx
  xor    ebx, ebx           { Zero EBX and EDX }
  xor    edx, edx
  inc    edx                { Set EDX to 1 }

@@Next:
  or     ebx, ebx
  je     @@NoTab            { Jump to NoTab if spacecount is zero }
  mov    eax, edx           { IPos to EAX }
  push   edx
  xor    edx, edx
  div    ecx
  cmp    edx, 1             { Is mod = 1? }
  pop    edx
  jne    @@NoTab            { If not, no tab }

  sub    edi, ebx
  mov    byte ptr [edi], 9h { Store a tab }
  inc    edi
  xor    ebx, ebx           { Reset spacecount }

@@NoTab:
  mov    al, [esi]          { Get next input character }
  inc    esi
  or     al, al             { End of string? }
  jz     @@Done             { Yes, done }
  inc    ebx                { Increment SpaceCount }
  cmp    al, 20h            { Is character a space? }
  jz     @@Store            { Yes, store it for now }
  xor    ebx, ebx           { Reset SpaceCount }
  cmp    al, 27h            { Is it a quote? }
  jz     @@Quotes           { Yep, enter quote loop }
  cmp    al, 22h            { Is it a doublequote? }
  jnz    @@Store            { Nope, store it }

@@Quotes:
  mov    ah, al             { Save quote start }

@@NextQ:
  mov    [edi], al          { Store quoted character }
  inc    edi
  mov    al, [esi]          { Get next character }
  inc    esi
  inc    edx                { Increment Ipos }
  cmp    edx, ecx           { At end of line? }
  jae    @@Store            { If so, exit quote loop }

  cmp    al, ah             { Matching end quote? }
  jnz    @@NextQ            { Nope, stay in quote loop }
  cmp    al, 27h            { Single quote? }
  jz     @@Store            { Exit quote loop }
  cmp    byte ptr [esi-2],'\'  { Previous character an escape? }
  jz     @@NextQ            { Stay in if so }

@@Store:
  mov    [edi], al          { Store last character }
  inc    edi
  inc    edx                { Increment input position }
  jmp    @@Next             { Repeat while characters left }

@@Done:
  mov    byte ptr [edi], 0h
  pop    esi
  pop    edi
  pop    ebx
  pop    eax
end;

function DetabZ(Dest, Src : PAnsiChar; TabSize : Byte) : PAnsiChar;
  { -Expand tabs in a string to blanks on spacing TabSize- }
register;
asm
  push    eax           { Save Dest for return value }
  push    edi           { Save EDI, ESI and EBX, we'll be changing them }
  push    esi
  push    ebx

  mov     esi, edx      { ESI -> Src }
  mov     edi, eax      { EDI -> Dest }
  xor     ebx, ebx      { Get TabSize in EBX }
  add     bl, cl
  jz      @@Done        { Exit if TabSize is zero }

  xor     edx, edx      { Set output length to zero }

@@Next:
  mov     al, [esi]
  inc     esi           { Get next input character }
  or      al, al        { Is it a null? }
  jz      @@Done        { Yes-all done }
  cmp     al, 09        { Is it a tab? }
  je      @@Tab         { Yes, compute next tab stop }
  mov     [edi], al     { No, store to output }
  inc     edi
  inc     edx           { Increment output length }
  jmp     @@Next        { Next character }

@@Tab:
  push    edx           { Save output length }
  mov     eax, edx      { Get current output length in EDX:EAX }
  xor     edx, edx
  div     ebx           { Output length MOD TabSize in DX }
  mov     ecx, ebx      { Calc number of spaces to insert... }
  sub     ecx, edx      { = TabSize - Mod value }
  pop     edx
  add     edx, ecx      { Add count of spaces into current output length }

  mov     eax,$2020     { Blank in AH, Blank in AL }
  shr     ecx, 1        { Store blanks }
  rep     stosw
  adc     ecx, ecx
  rep     stosb
  jmp     @@Next        { Back for next input }

@@Done:
  mov     byte ptr [edi], 0h { Store final null terminator }

  pop     ebx           { Restore caller's EBX, ESI and EDI }
  pop     esi
  pop     edi
  pop     eax           { Return Dest }
end;

function HasExtensionZ(Name : PAnsiChar; var DotPos : Cardinal) : Boolean;
  {-Return whether and position of extension separator dot in a pathname}
var
  I, L : Integer;
  Pos : Cardinal;
  P : TSmallArray;
begin
  I := -1;
  DotPos := Cardinal(I);
  Result := False;
  L := StrLen(Name);
  if L = 0 then
    Exit;
  for I := L-1 downto 0 do
    if (Name[I] = '.') and (DotPos = Cardinal(-1)) then
      DotPos := I;
  Result := (DotPos <> Cardinal(-1)) and not
    StrChPosZ(StrStCopyZ(P, Name, Succ(DotPos), StMaxFileLen), '\', Pos);
end;

function DefaultExtensionZ(Dest : PAnsiChar; Name, Ext : PAnsiChar) : PAnsiChar;
  {-Return a pathname with the specified extension attached}
var
  DotPos : Cardinal;
begin
  if HasExtensionZ(Name, DotPos) then
    StrCopy(Dest, Name)
  else if StrLen(Name) = 0 then
    Dest[0] := #0
  else begin
    StrCopy(Dest, Name);
    StrCat(Dest, '.');
    StrCat(Dest, Ext);
  end;
  Result := Dest;
end;

function ForceExtensionZ(Dest : PAnsiChar; Name, Ext : PAnsiChar) : PAnsiChar;
  {-Return a pathname with the specified extension attached}
var
  DotPos : Cardinal;
begin
  if HasExtensionZ(Name, DotPos) then
    Dest := StrCat(StrStCopyZ(Dest, Name, 0, Succ(DotPos)), Ext)
  else if StrLen(Name) = 0 then
    Dest[0] := #0
  else begin
    Dest := StrCopy(Dest, Name);
    Dest := StrCat(Dest, '.');
    Dest := StrCat(Dest, Ext);
  end;
  Result := Dest;
end;

function JustExtensionZ(Dest : PAnsiChar; Name : PAnsiChar) : PAnsiChar;
  {-Return just the extension of a pathname}
var
  DotPos : Cardinal;
begin
  if HasExtensionZ(Name, DotPos) then
    Dest := StrStCopyZ(Dest, Name, Succ(DotPos), StMaxFileLen)
  else
    Dest[0] := #0;
  Result := Dest;
end;

function JustFilenameZ(Dest : PAnsiChar; PathName : PAnsiChar) : PAnsiChar;
  {-Return just the filename of a pathname}
var
  I : Integer;
begin
  I := StrLen(PathName);
  while (I > 0) and (not (PathName[I-1] in DosDelimSet)) do
    Dec(I);
  Dest := StrStCopyZ(Dest, PathName, I, StMaxFileLen);
  Result := Dest;
end;

function JustNameZ(Dest : PAnsiChar; PathName : PAnsiChar) : PAnsiChar;
  {-Return just the name (no extension, no path) of a pathname}
var
  DotPos : Cardinal;
  T : TSmallArray;
begin
  JustFileNameZ(T, PathName);
  if HasExtensionZ(T, DotPos) then
    Dest := StrStCopyZ(Dest, T, 0, DotPos)
  else
    StrCopy(Dest, T);
  Result := Dest;
end;

function JustPathnameZ(Dest : PAnsiChar; PathName : PAnsiChar) : PAnsiChar;
  {-Return just the drive:directory portion of a pathname}
var
  I : Longint;
begin
  I := StrLen(PathName);
  repeat
    Dec(I);
  until (I = -1) or (PathName[I] in DosDelimSet);

  if I = -1 then
    {Had no drive or directory name}
    Dest[0] := #0
  else if I = 0 then begin
    {Either the root directory of default drive or invalid pathname}
    Dest[0] := PathName[0];
    Dest[1] := #0;
  end
  else if (PathName[I] = '\') then begin
    if PathName[Pred(I)] = ':' then
      {Root directory of a drive, leave trailing backslash}
      Dest := StrStCopyZ(Dest, PathName, 0, Succ(I))
    else
      {Subdirectory, remove the trailing backslash}
      Dest := StrStCopyZ(Dest, PathName, 0, I);
  end else
    {Either the default directory of a drive or invalid pathname}
    Dest:= StrStCopyZ(Dest, PathName, 0, Succ(I));
  Result := Dest;
end;

function AddBackSlashZ(Dest : PAnsiChar; DirName : PAnsiChar) : PAnsiChar;
  {-Add a default backslash to a directory name}
var
  L : Integer;
begin
  Result := Dest;
  StrCopy(Dest, DirName);
  L := StrLen(DirName);
  if (L > 0) then begin
    if ((L = 2) and (Dest[1] = ':')) or
       ((L > 2) and (Dest[L-1] <> '\')) then begin
      Dest[L] := '\';
      Dest[L+1] := #0;
    end;
  end;
end;

function CleanFileNameZ(Dest, FileName : PAnsiChar) : PAnsiChar;
  {-Return filename with at most 8 chars of name and 3 of extension}
var
  DotPos : Cardinal;
  NameLen : Integer;
  P2 : TSmallArray;
begin
  if HasExtensionZ(FileName, DotPos) then begin
    {Take the first 8 chars of name and first 3 chars of extension}
    NameLen := DotPos;
    if NameLen > 8 then
      NameLen := 8;
    StrStCopyZ(Dest, FileName, 0, NameLen);
    StrCat(Dest, StrStCopyZ(P2, FileName, DotPos, 4));
  end else
    {Take the first 8 chars of name}
    StrStCopyZ(Dest, FileName, 0, 8);
  Result := Dest;
end;

function CleanPathNameZ(Dest : PAnsiChar; PathName : PAnsiChar) : PAnsiChar;
  {-Return a pathname cleaned up as DOS will do it}
var
  I : Word;
  S1, S, OName : TSmallArray;
begin
  Result := Dest;
  StrCopy(Dest, PathName);
  I := StrLen(PathName);
  OName[0] := #0;
  while I > 0 do begin
    Dec(I);
    if I > 1 then
      if (Dest[I] = '\') and (Dest[I-1] = '\') then
        if (Dest[I-2] <> ':') then
          StrChDeletePrimZ(Dest, I);
  end;
  I := StrLen(Dest);
  while I > 0 do begin
    Dec(I);
    {Get the next directory or drive portion of pathname}
    while ((I > 0) and not (Dest[I] in DosDelimSet)) do                {!!.02}
      Dec(I);
    {Clean it up and prepend it to output string}
    StrStCopyZ(S1, Dest, I + 1, StMaxFileLen);
    StrCopy(S, OName);
    CleanFileNameZ(OName, S1);
    StrCat(OName, S);
    {if I >= 0 then begin}
      StrCopy(S, OName);
      StrStCopyZ(OName, Dest, I, 1);
      StrCat(OName, S);
      StrStDeletePrimZ(Dest, I, 255);
    {end;}
  end;
  StrCopy(Dest, OName);
end;

function ConvertToShortString(S : PAnsiChar; var SS : ShortString) : integer;

var
  LenS : integer;
begin
  {returns 0 if the string was converted successfully
           1 if the string is nil
           2 if the string length is greater than 255}
  if (S = nil) then begin
    Result := 1;
  end
  else begin
    LenS := StrLen(S);
    if (LenS > 255) then begin
      Result := 2;
    end
    else begin
      {we can't use StrPas in 32-bit since it assumes a long string
       and that would incur too much overhead, so convert to a short
       string from first principles}
      Move(S^, SS[1], LenS);
      SS[0] := char(LenS);
      Result := 0;
    end;
  end;
end;