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, 8313 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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(1)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Windows 8
gelöst Active Directory Default User.v2 Profile - Windows 8.1 Apps Error (4)

Frage von adm2015 zum Thema Windows 8 ...

Windows Server
Daten löschen - Windows Error Reporting (WER) (2)

Frage von Otto1699 zum Thema Windows Server ...

KVM
gelöst Proxmox KVM - Disk read error nach verschieben der disk (6)

Frage von ketanest112 zum Thema KVM ...

Windows Update
gelöst WSUS Server: Content: Error:Forbidden (403) (2)

Frage von EDV-Oellerking zum Thema Windows Update ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...