home *** CD-ROM | disk | FTP | other *** search
/ Hacks & Cracks / Hacks_and_Cracks.iso / programs / x-brain / tools / fcomp.pas < prev    next >
Pascal/Delphi Source File  |  1998-11-19  |  12KB  |  382 lines
  1. { Ja, ja ihr habt ja recht...ist ein bischen unordentlich aber ich hab keine
  2.   Zeit für ein schönen SourceCode! Also versuchts zu entziffern oder laßts
  3.   sein! --- Eigentlich ganz einfach und simple & ein wenig langsam... :}
  4.  
  5. uses dos,crt;
  6.  
  7. const bufsize = 16384;
  8.       clockchar = 10;
  9.       ta : array [1..clockchar] of char = #229#230#231#232#233#234#235#236#238#237;
  10.       nohack = 'Beide Dateien sind inhaltlich vollkommen identisch!';
  11.       hack = 'O.K. done...HaPpY hAcKyInG...';
  12.       verpos = 'Verglichen bis filepos.: ';
  13.       abort = '%) ... Abbruch durch user!'#13#10;
  14.       dfp1 = 'ERROR: Kann Datei : ';
  15.       dfp2 = ' nicht öffnen!';
  16.       HexList :ARRAY[0..15] OF CHAR ='0123456789ABCDEF';
  17.       VideoSeg  : Word = $b800 ;
  18.  
  19.  
  20. var FromF, ToF: file;
  21.     tf : text;
  22.     x, NumRead, NumWritten: Word;
  23.     buf,fub: array[1..bufsize] of Char;
  24.     percent, y, counter : byte;
  25.     hex, found : boolean;
  26.     ld, foundn,d,readcount,fsize,fpos : longint;
  27.     cracker, title : string[50];
  28.     reg : registers;
  29.  
  30. Procedure fastwrite(x, y, attr : Byte; Zlika : String); assembler;
  31. Asm
  32.   Mov  ES, VideoSeg
  33.   DEC  Y
  34.   Mov  AL, 160
  35.   Mul  Byte Ptr y
  36.   Mov  BL, x
  37.   Xor  BH, BH
  38.   ShL  BX, 1
  39.   Add  BX, AX
  40.   Push DS
  41.   ClD
  42.   LDS  SI, Zlika
  43.   LodSB
  44.   Mov  CL, AL
  45.   Xor  CH, CH
  46.   Mov  DI, BX
  47.   Mov  AH, attr
  48. @Boucle:
  49.   LodSB
  50.   StoSW
  51.   Loop @Boucle
  52.   Pop  DS
  53. end ;
  54.  
  55. procedure cursor(onoff:boolean);
  56. begin
  57. if onoff then begin
  58. ASM
  59.     MOV  AH, 1
  60.       MOV  CX,  0607h
  61.      INT  10h
  62.    end;
  63.  end
  64. else
  65.  begin
  66.     asm
  67.       MOV  AH, 1
  68.        MOV  CX, 1400h
  69.       INT  10h
  70.     end;
  71.   END;
  72. end;
  73.  
  74. FUNCTION HiWord( Long :LONGINT ) :WORD; ASSEMBLER;
  75. ASM
  76.   Mov AX,Long.WORD[2]
  77. END;
  78. FUNCTION LoWord( Long :LONGINT ) :WORD; ASSEMBLER;
  79. ASM
  80.   Mov AX,Long.WORD[0]
  81. END;
  82.  
  83. FUNCTION BHex( V :BYTE ) :STRING;
  84. BEGIN
  85.   BHex := HexList[V Shr 4] + HexList[V Mod 16];
  86. END;
  87.  
  88. FUNCTION WHex( V :WORD ) :STRING;
  89. BEGIN
  90.   WHex := Bhex(Hi(V)) + BHex(Lo(V));
  91. END;
  92.  
  93. FUNCTION LHex( Long :LONGINT ) :STRING;
  94. BEGIN
  95.   LHex := WHex(HiWord(Long))+WHex(LoWord(Long));
  96. END;
  97.  
  98. function UpStr(s:string):string; assembler;
  99.   asm
  100.     push ds
  101.     lds  si,s
  102.     les  di,@result
  103.     lodsb
  104.     stosb
  105.     xor  ch,ch
  106.     mov  cl,al
  107.     jcxz @empty
  108.   @upperLoop:
  109.     lodsb
  110.     cmp  al,'a'
  111.     jb   @cont
  112.     cmp  al,'z'
  113.     ja   @cont
  114.     sub  al,' '
  115.   @cont:
  116.     stosb
  117.     loop @UpperLoop
  118.   @empty:
  119.     pop  ds
  120.   end;
  121.  
  122. procedure fireball;
  123.      type
  124.        bytearray=array[0..15] of byte;
  125.        chararray=array[0..8] of record
  126.          chn:byte;
  127.          chardata:bytearray;
  128.        end;
  129.      const
  130.        newchars:chararray=(
  131. (chn:229; chardata:(0,0,127,249,193,193,192,252,228,196,192,192,196,128,128,128)),
  132. (chn:230; chardata:(0,16,16,24,24,28,28,28,28,28,20,20,20,16,16,0)),
  133. (chn:231; chardata:(0,0,224,248,222,211,211,198,252,240,248,220,206,198,132,132)),
  134. (chn:232; chardata:(0,126,255,195,193,193,192,241,249,200,200,192,193,255,126,0)),
  135. (chn:233; chardata:(0,0,0,0,0,0,0,255,255,140,136,8,8,0,0,0)),
  136. (chn:234; chardata:(0,0,252,254,215,215,222,248,252,214,211,195,199,253,249,193)),
  137. (chn:235; chardata:(0,0,24,60,110,110,110,203,203,255,203,203,203,193,193,129)),
  138. (chn:236; chardata:(0,128,128,192,192,192,192,224,224,224,224,224,252,126,3,1)),
  139. (chn:255; chardata:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)));
  140.      begin
  141.        for x:=0 to 8 do
  142.          begin
  143.            with reg do
  144.              begin
  145.                ah:=$11;
  146.                al:=$0;
  147.                bh:=$10;
  148.                bl:=0;
  149.                cx:=1;
  150.                dx:=newchars[x].chn;
  151.                es:=seg(newchars[x].chardata);
  152.                bp:=ofs(newchars[x].chardata);
  153.                intr($10,reg);
  154.              end;
  155.          end;
  156.      end;
  157.  
  158. procedure clock;
  159.      type
  160.        bytearray=array[0..15] of byte;
  161.        chararray=array[0..clockchar] of record
  162.          chn:byte;
  163.          chardata:bytearray;
  164.        end;
  165.      const
  166.        newchars:chararray=(
  167. (chn:229; chardata:(0,126,255,255,255,126,126,60,24,36,66,66,129,129,129,126)),
  168. (chn:230; chardata:(0,126,225,255,255,126,126,60,24,44,74,74,137,137,129,126)),
  169. (chn:231; chardata:(0,126,129,227,247,126,126,60,24,44,74,74,137,137,189,126)),
  170. (chn:232; chardata:(0,126,129,129,227,118,126,60,24,44,74,74,137,157,255,126)),
  171. (chn:233; chardata:(0,126,129,129,129,98,126,60,24,44,74,74,157,255,255,126)),
  172. (chn:234; chardata:(0,126,129,129,129,66,102,60,24,44,74,126,255,255,255,126)),
  173. (chn:235; chardata:(0,126,129,129,129,66,66,36,24,60,126,126,255,255,255,126)),
  174. (chn:236; chardata:(0,0,126,255,189,129,66,60,24,60,126,255,255,126,0,0)),
  175. (chn:237; chardata:(0,0,126,255,255,126,60,24,60,66,129,189,255,126,0,0)),
  176. (chn:238; chardata:(0,0,0,0,0,60,126,255,255,126,60,0,0,0,0,0)),
  177. (chn:255; chardata:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)));
  178.      begin
  179.        for x:=0 to clockchar do
  180.          begin
  181.            with reg do
  182.              begin
  183.                ah:=$11;
  184.                al:=$0;
  185.                bh:=$10;
  186.                bl:=0;
  187.                cx:=1;
  188.                dx:=newchars[x].chn;
  189.                es:=seg(newchars[x].chardata);
  190.                bp:=ofs(newchars[x].chardata);
  191.                intr($10,reg);
  192.              end;
  193.          end;
  194.      end;
  195.  
  196. procedure checkforstr;
  197. begin
  198. d:=0;
  199. repeat
  200. inc(d);
  201.  
  202. if buf[d] <> fub[d] then begin
  203.    if not found then begin
  204.       {$I-}
  205.       Assign(tf,'CRACKPOS.TXT');
  206.       rewrite(tf);
  207.       {$I+}
  208.       if ioresult <> 0 then begin writeln(' Kann Protokolldatei " CRACKPOS.TXT " nicht erstellen!'); halt; end;
  209.       gotoxy(51,y);write('Protokolldatei:');textcolor(11);write(' CRACKPOS.TXT');textcolor(7);
  210.       textattr:=12; gotoxy(29,y); write('FOUND!'); cursor(true); textattr:=15;
  211.       gotoxy(1,y-1); clreol;
  212.       gotoxy(1,y-1); write('Enter ProgramTitle: '); textattr:=10; readln(title);
  213.       gotoxy(1,y-1); clreol; textattr:=15;
  214.       gotoxy(1,y-1); write('Enter CrackerName : '); textattr:=10; readln(cracker);
  215.       cursor(false);
  216.       textattr:=7;
  217.       gotoxy(1,y-1); clreol;
  218.       writeln(tf,'Dateivergleich von ORG.:"',upstr(paramstr(1)),'" mit CRK.:"',upstr(paramstr(2)),'".');
  219.       write(tf,'Erstelle X-BRAIN Eintrag:',#13#10#10,'TITLE: ',title,#13#10,'CRACKER: ',cracker,#13#10,'FILE.SEARCH: '
  220.                 ,upstr(paramstr(2)),'; #',filesize(ToF));
  221.                   found:=true; end;
  222.    inc(foundn); gotoxy(29,y); write('found($'); textattr:=14; write(foundn); textattr:=07; write(')');
  223. (* Entry von der alten Version:
  224.     writeln(tf,'pos.: ',fpos+d-1,' / (',lhex(fpos+d-1),') ... char: <',buf[d],'> & <',fub[d],
  225.               '> / [#',ord(buf[d]),'..#',ord(fub[d]),'] [',bhex(ord(buf[d])),#46#46,bhex(ord(fub[d])),#93); *)
  226.    if hex then if (buf[d-1] = fub[d-1]) then
  227.    write(tf,#13#10,'PATCH.STR: ',lhex(fpos+d-1),'h; ',bhex(ord(fub[d])),'h') else
  228.       write(tf,' ',bhex(ord(fub[d])),'h')
  229.       else
  230.    if (buf[d-1] = fub[d-1]) then begin if foundn > 1 then write(tf,'>');
  231.    write(tf,#13#10,'PATCH.STR: ',lhex(fpos+d-1),'h; <',fub[d]); end else
  232.       write(tf,fub[d]);
  233.  
  234.       end;
  235. until (d=bufsize) or (keypressed);
  236. for ld := 1 to bufsize do buf[ld]:=#0;
  237. for ld := 1 to bufsize do fub[ld]:=#0;
  238. end;
  239.  
  240.  
  241.  
  242. begin
  243.   textattr:=07;write('Filecomparer v1.2 by ');textcolor(14); write('FIRE-BALL');
  244.   textcolor(7); writeln(' / sTRONTIUm 9000   *-*-*   Tastendruck = Abbruch.');
  245.   if paramstr(2) = '' then begin writeln('Angabefehler!   ---[ FCOMP ORGFILE.EXE CRKFILE.EXE ]--- ',#13#10,
  246.                                          '       parameter(3): FCOMP ORGF.EXE CRKF.EXE TXT  -  output in <...> as in hex.');
  247.                                          halt; end;
  248.   {$I-}
  249.   Assign(FromF, paramstr(1));
  250.   Reset(FromF, 1);
  251.   {$I+}
  252.   if ioresult <> 0 then begin
  253.    writeln(#13#10,dfp1,upstr(paramstr(1)),dfp2); halt; end;
  254.   {$I-}
  255.   Assign(ToF, paramstr(2));
  256.   Reset(ToF, 1);
  257.   {$I+}
  258.   if ioresult <> 0 then begin
  259.    writeln(#13#10,dfp1,upstr(paramstr(2)),dfp2); halt; end;
  260.   cursor(false);
  261.   writeln('Vergleiche: "',upstr(paramstr(1)),'" mit "',upstr(paramstr(2)),'" :-) :)');
  262.   write('OutPutModi: ');
  263.   if upstr(paramstr(3)) = 'TXT' then begin hex:=false; writeln('TextMode <...>'); end else
  264.                                      begin hex:=true; writeln('HexMode ...h'); end;
  265.   clock;
  266.   y:=wherey;
  267.   for ld := 1 to bufsize do buf[ld]:=#0;
  268.   for ld := 1 to bufsize do fub[ld]:=#0;
  269.   fsize:=filesize(fromf);
  270.   found:=false;
  271.   readcount:=0;
  272.   fpos:=0;
  273.   counter:=1;
  274.   foundn:=0;
  275.   write('Status    : σ ---> 0%');
  276.   repeat
  277.    if counter > clockchar then counter:=1;
  278.    gotoxy(13,y);write(ta[counter]);
  279.    inc(counter);
  280.     fpos:=readcount*bufsize;
  281.     seek(FromF,fpos);
  282.     BlockRead(FromF,buf,bufsize,NumRead);
  283.     seek(ToF,fpos);
  284.     BlockRead(ToF,fub,bufsize,numwritten);
  285.     checkforstr;  gotoxy(20,y);
  286.     If ((Fpos+bufsize) <= FSize) Then Percent := (((Fpos+bufsize) * 100) Div Fsize ) Else Percent := 100;
  287.     write(percent,#37); inc(readcount);
  288.   until (NumRead = 0) or (NumWritten <> NumRead) or (keypressed);
  289.   gotoxy(13,y);write(ta[9]);
  290.   fireball; fastwrite(21,y-4,14,#229#230#231#232#233#234#235#236#236);
  291.   if (foundn > 1) and not (hex) then write(tf,'>');
  292.   if found then begin writeln(#13#10,Hack);writeln(tf,#13#10#10,Hack); end
  293.      else writeln(#13#10,NoHack);
  294.    if keypressed then begin
  295.          If ((Fpos+d-1) <= FSize) Then Percent := (((Fpos+d-1) * 100) Div Fsize ) Else Percent := 100;
  296.          if (fpos+d-1) > fsize then fpos:=fsize else fpos:=fpos+d-1;
  297.          if found then write(Tf,Verpos,fpos,' (',percent,Abort);
  298.          write(Verpos,fpos,' (',percent,Abort); end;
  299.   if found then close(tf);
  300.   Close(FromF);
  301.   Close(ToF);
  302.   cursor(true);
  303. end.
  304.  
  305. (****************************************************************************)
  306. (**************************** C R E A T E F I L E ***************************)
  307. (****************************************************************************)
  308.  
  309. var d, fsize : longint;
  310.     i : integer;
  311.     f : text;
  312.     name : string;
  313.     dummy : byte;
  314.     ch : char;
  315.     s : string[1];
  316.  
  317. begin
  318. if paramstr(2) = '' then begin writeln('FileCreator v1.1'#13#10'Usage: CREATEF <NAME> <SIZE> <CHAR>'#13#10,
  319.                                        '       if none <CHAR> given fillchar = space (20h)'); halt; end;
  320. if paramstr(3) <> '' then s:=paramstr(3) else s := ' ';
  321. name:=paramstr(1);
  322. val(paramstr(2),fsize,i);
  323. writeln('fillchar: "',s,'"');
  324. writeln('creating "'+name+'"...(',fsize,')');
  325. assign(f,name);
  326. rewrite(f);
  327. for d := 1 to fsize do write(f,s);
  328. close(f);
  329. dummy:=length(name)+1; repeat delete(name,dummy,1); dec(dummy); until (name[dummy]='.') or (dummy=0);
  330. if dummy=0 then name:='X.';
  331. writeln('creating "'+name+'org"...(',fsize,')');
  332. assign(f,name+'org');
  333. rewrite(f);
  334. for d := 1 to fsize do write(f,s);
  335. close(f);
  336. writeln('done.');
  337. end.
  338.  
  339. (****************************************************************************)
  340. (****************************** C U T S P A C E *****************************)
  341. (****************************************************************************)
  342.  
  343. uses crt;
  344. var i : byte;
  345.     d : word;
  346.     s : string;
  347.     f,f2 : text;
  348.     counter : longint;
  349.  
  350. begin
  351. if paramstr(2) = '' then begin writeln('This util cuts SpaceChars from the end of a line, to spare bytes.',
  352.                                        #13#10,'Usage: CUTSPACE infile outfile'); halt; end;
  353. {$I-}
  354. assign(f,paramstr(1));
  355. reset(f);
  356. {$I+}
  357. if ioresult <> 0 then begin writeln('Error opening: " ',paramstr(1),' " !'); halt(1); end;
  358. {$I-}
  359. assign(f2,paramstr(2));
  360. rewrite(f2);
  361. {$I+}
  362. if ioresult <> 0 then begin writeln('Error creating: " ',paramstr(2),' " !'); halt(1); end;
  363. d:=1;
  364. counter:=1;
  365. writeln('converting: "',paramstr(1),'" to "',paramstr(2),'"...');
  366. repeat
  367. readln(f,s);
  368. i:=length(s)+1;
  369. dec(counter);
  370. repeat
  371. delete(s,i,1);
  372. dec(i);
  373. inc(counter);
  374. until s[i] <> ' ';
  375. writeln(f2,s);
  376. inc(d);
  377. gotoxy(1,wherey);write(d,' lines done.');
  378. until eof(f);
  379. writeln('    --->     ',counter-1,' bytes spared!');
  380. close(f);
  381. close(f2);
  382. end.