Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Pascal: Runtime error 202 at xxx

Frage Entwicklung Pascal und Delphi

Mitglied: nullplan001

nullplan001 (Level 1) - Jetzt verbinden

22.11.2005, aktualisiert 04.01.2006, 8336 Aufrufe, 3 Kommentare

Hi all,
ich habe da mal eine Frage. Und zwar habe ich ein Programm zur base64-(De-)Codierung geschrieben. Ich nehme mir mal die Freiheit, es zu posten:
<div class="code">program base64;
var
instr:string;
i:longint;

function p(x,y:longint):integer;
var prod:integer;
begin
if i=0 then exit(1);
if i=1 then exit(x);
prod:=1;
for i:=1 to y do begin
prod:=prod*x;
end;
if i<0 then prod:=1 div prod;
exit(prod);
end;

procedure showhelp;
begin
writeln(stderr,'Syntax f&#65533;r dieses Tool:');
writeln(stderr,' base64 {/e|/d} instring');
writeln(stderr,' /e String nach Base64 codieren');
writeln(stderr,' /d String aus Base64 dekodieren');
writeln(stderr,' instring Zu (de)kodierender String');
end;

function ord64(hchar:char):byte;
begin
case hchar of
'A','=': exit(0);
'B': exit(1);
'C': exit(2);
'D': exit(3);
'E': exit(4);
'F': exit(5);
'G': exit(6);
'H': exit(7);
'I': exit(8);
'J': exit(9);
'K': exit(10);
'L': exit(11);
'M': exit(12);
'N': exit(13);
'O': exit(14);
'P': exit(15);
'Q': exit(16);
'R': exit(17);
'S': exit(18);
'T': exit(19);
'U': exit(20);
'V': exit(21);
'W': exit(22);
'X': exit(23);
'Y': exit(24);
'Z': exit(25);
'a': exit(26);
'b': exit(27);
'c': exit(28);
'd': exit(29);
'e': exit(30);
'f': exit(31);
'g': exit(32);
'h': exit(33);
'i': exit(34);
'j': exit(35);
'k': exit(36);
'l': exit(37);
'm': exit(38);
'n': exit(39);
'o': exit(40);
'p': exit(41);
'q': exit(42);
'r': exit(43);
's': exit(44);
't': exit(45);
'u': exit(46);
'v': exit(47);
'w': exit(48);
'x': exit(49);
'y': exit(50);
'z': exit(51);
'0': exit(52);
'1': exit(53);
'2': exit(54);
'3': exit(55);
'4': exit(56);
'5': exit(57);
'6': exit(58);
'7': exit(59);
'8': exit(60);
'9': exit(61);
'+': exit(62);
'/': exit(63);
else exit(-1);
end;
end;

function chr64(hbyte:byte):char;
begin
case hbyte of
0: exit('A');
1: exit('B');
2: exit('C');
3: exit('D');
4: exit('E');
5: exit('F');
6: exit('G');
7: exit('H');
8: exit('I');
9: exit('J');
10: exit('K');
11: exit('L');
12: exit('M');
13: exit('N');
14: exit('O');
15: exit('P');
16: exit('Q');
17: exit('R');
18: exit('S');
19: exit('T');
20: exit('U');
21: exit('V');
22: exit('W');
23: exit('X');
24: exit('Y');
25: exit('Z');
26: exit('a');
27: exit('b');
28: exit('c');
29: exit('d');
30: exit('e');
31: exit('f');
32: exit('g');
33: exit('h');
34: exit('i');
35: exit('j');
36: exit('k');
37: exit('l');
38: exit('m');
39: exit('n');
40: exit('o');
41: exit('p');
42: exit('q');
43: exit('r');
44: exit('s');
45: exit('t');
46: exit('u');
47: exit('v');
48: exit('w');
49: exit('x');
50: exit('y');
51: exit('z');
52: exit('0');
53: exit('1');
54: exit('2');
55: exit('3');
56: exit('4');
57: exit('5');
58: exit('6');
59: exit('7');
60: exit('8');
61: exit('9');
62: exit('+');
63: exit('/');
else exit('<');
end;
end;

function binconvert(bstr:string):integer;
var
erg,z:integer;

begin
z:=0;
for i:=length(bstr) downto 1 do begin
case bstr[i] of
'0':;
'1':erg:=erg+p(2,z);
else exit(-1);
end;
inc(z);
end;
exit(erg);
end;

procedure decode(hstr:string);
const
z:longint=1;
binastr:string='';
outstr:string='';
var
hlparr:array[1..maxint] of string;

begin
for i:=1 to length(hstr) do begin
if ord64(binastr[i])=-1 then begin
writeln('Ung&#65533;ltiges Zeichen: ',hstr[i]);
exit{(1)};
end;
binastr:=binastr+binstr(ord64(hstr[i]),6);
end;
for i:=0 to length(binastr) do begin
if i mod 8 = 0 then begin
hlparr[z]:=copy(binastr,i,8);
inc(z);
end;
end;
for i:=1 to z do begin
outstr:=outstr+chr(binconvert(hlparr[i]));
end;
writeln(outstr);
end;

procedure encode(hstr:string);
const
binastr:string='';
outstr:string='';
z:longint=1;
var
hlparr: array [1..maxint] of string;

begin
for i:=1 to length(hstr) do begin
binastr:=binastr+binstr(ord(hstr[i]),8);
end;
for i:=0 to length(binastr) do begin
if i mod 6 = 0 then begin
hlparr[z]:=copy(binastr,i,6);
inc(z);
end;
end;
for i:=1 to z do begin
outstr:=outstr+chr64(binconvert(hlparr[i]));
end;
for i:=length(outstr) downto length(outstr)-2 do begin
if outstr[i]='A' then begin
delete(outstr,i,1);
insert('=',outstr,i);
break;
end;
end;
writeln(outstr);
end;

BEGIN
if (paramcount=0) or (paramstr(1)='/?') or (paramstr(1)='/h') or ((paramstr(1)<>'/d') and (paramstr(1)<>'/e')) then showhelp;
instr:=paramstr(2);
if paramstr(1)='/d' then decode(instr);
if paramstr(1)='/e' then encode(instr);
END.</div>
Jedenfalls, wenn ich das kompiliere und starte, bekomme ich folgenden Fehler:
</tt>Runtime error 202 at $00401A2A
$00401A2A
$00401DBD</tt>
Ich habe zwar gelesen, was dieser Fehler bedeutet (Stapelüberlauf), aber ich habe keine Ahnung, wie ich ihn beheben könnte! Help me, please!!!
P.S: Ich nutze Free Pascal.

edit: Nachdem ich die Prozeduren decode und encode ins Hauptprogram geschoben habe, sagt er nur noch "<". Kann sich das einer von euch erklären. Hinweis: Meine Eingabe war <tt>base64 /e abcd</tt>
Mitglied: 8644
04.01.2006 um 09:21 Uhr
Hi,

habs jetzt erst gelesen. Falls es noch akut ist, eins ist mir aufgefallen:

Stapelüberläufe resultieren meistens aus Endlosschleifen.


function p(x,y:longint):integer;
var prod:integer;
begin
if i=0 then exit(1);
if i=1 then exit(x);
prod:=1;
for i:=1 to y do begin
prod:=prod*x;
end;
if i<0 then prod:=1 div prod;
exit(prod);
end;


Welchen Wert hat y in dieser Funktion?

Psycho

P.S. Wenn ich mehr Zeit habe, nehme ich es mal intensiver auseinander
Bitte warten ..
Mitglied: nullplan001
04.01.2006 um 12:35 Uhr
Hi Psycho,
nö, das Problem ist nicht mehr akkut. Ich habe das Problem folgendermaßen gelöst:
<div class="code">program base64;
const b64str:shortstring='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
binastr:widestring='';
hstr:string[6]='';
outstr:widestring='';
var
mode:boolean;
f:text;
instr:shortstring;
i:integer;

{$I showhelp.inc} {procedure showhelp(wrongparam:boolean); Gibt die Hilfe aus}
{$I bin2int.inc} {function bin2int(binastr:string):integer; Wandelt binstr in int um}
begin
case upcase(paramstr(1)[2]) of
'D': mode:=false;
'E': mode:=true;
'?','H': showhelp(false);
else showhelp(true);
end;
if paramcount<2 then showhelp(true);
assign(f,'');
rewrite(f);
instr:=paramstr(2);
if mode then begin
for i:=1 to length(instr) do binastr:=binastr + binstr(ord(instr[i]),8); {function binstr(i,min:integer):string; gibt Binären String der übergebenen Zahl zurück und erhöht die Länge auf mindesten min, indem Nullen vorne dran gesetzt werden}
repeat
hstr:=copy(binastr,1,6);
delete(binastr,1,6);
outstr:=outstr + b64str[bin2int(hstr)+1];
until length(binastr)<8;
end;
end else begin
for i:=1 to length(instr) do
binastr:=binstr(pos(instr[i])-1,6);
repeat
hstr:=copy(binastr,1,8);
delete(binastr,1,8);
outstr:= outstr + chr(bin2int(hstr));
until length(binastr)<8;
end;
write(f,outstr);
end.
</div>
Also gut, das ist jetzt nicht perfekt, aber mir schwebt vor, demnächst einen PHP-Codierer dahingehend zu schreiben. Und da ist eine Kodierungsfunktion schon eingebaut.
Bitte warten ..
Mitglied: 8644
04.01.2006 um 12:40 Uhr
nö, das Problem ist nicht mehr akkut.

...macht ja nichts, wäre aber hilfreich, kurz zu posten, wenn sich was erledigt hat!
Ich hätte sonst vielleicht heute abend den ganzen Code auseinander gepflückt

Psycho
Bitte warten ..
Ähnliche Inhalte
Exchange Server
Exhange 2016 bringt bei Server 2012 R2 MSDTC Error bei prüfung Requesites (1)

Frage von rainergugus zum Thema Exchange Server ...

Apache Server
Apache modProxy debug-log schreibt in error-log (6)

Frage von mic.wendt zum Thema Apache Server ...

Drucker und Scanner
Laserjet 3600N Fehler PCL Error (1)

Frage von grillinator95 zum Thema Drucker und Scanner ...

Neue Wissensbeiträge
Sicherheits-Tools

Sicherheitstest von Passwörtern für ganze DB-Tabellen

(1)

Tipp von gdconsult zum Thema Sicherheits-Tools ...

Peripheriegeräte

Was beachten bei der Wahl einer USV Anlage im Serverschrank

(9)

Tipp von zetboxit zum Thema Peripheriegeräte ...

Windows 10

Das Windows 10 Creators Update ist auf dem Weg

(6)

Anleitung von BassFishFox zum Thema Windows 10 ...

Heiß diskutierte Inhalte
Batch & Shell
gelöst ZIP-Archive nach Dateien durchsuchen und Pfade ausgeben (33)

Frage von evinben zum Thema Batch & Shell ...

Router & Routing
Routingproblem in Homerouter-Kaskade mit Raspi (19)

Frage von Oldschool zum Thema Router & Routing ...

Server
Freenas schlechte Schreib Performance bei NFS (16)

Frage von janosch12 zum Thema Server ...

Windows Server
Fehler Vertrauensstellung im AD (14)

Frage von thomas-99 zum Thema Windows Server ...