Правила форума
Прочтите прежде чем задавать вопрос!
Господа, необходима Ваша помощь!
Есть 2 программы, которые я писал год назад...
1.
uses crt, math, graph;
const
HEX_MODE = 16;
DATA_COUNT : integer = 0;
ENTROPY : extended = 0.0;
var
symb : array [0..255] of byte;
function FromDec(n, radix:longint):string;
var s: String;
const
digit: string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod radix)+1]+s;
n:=n div radix;
until n=0;
FromDec:=s;
end;
procedure printascii (var s:string);
var i:byte;
begin
for i:=1 to length(s) do begin
write(FromDec(ord(s[i]),HEX_MODE),#32);
if i mod 8 =0 then writeln;
end;
end;
procedure get_data_str (var s:string);
var
i:byte;
begin
DATA_COUNT:= length(s);
for i:=0 to 255 do symb[i]:=0;
for i:=1 to DATA_COUNT do symb[ord(s[i])] += 1;
for i:=0 to 255 do if symb[i]>0 then ENTROPY -= symb[i]* log2(symb[i]/DATA_COUNT)/DATA_COUNT;
end;
procedure initialization_graph ();
var
GD,GM: smallint;
begin
GD:= d8bit;
GM:= m800x600;
initgraph(GD,GM, '');
end;
procedure AMI_code (s:char);
function SIGN(var g:integer):integer;
begin
if g>0 then g *=-1 else g:=g;
end;
var i:integer;
binary : string;
AMI_arr :array[0..7] of integer;
pnz: integer;
begin
for i:=0 to 7 do AMI_arr[i]:=0;
binary := FromDec(ord(s),2);
writeln('BIN: ',binary);
pnz:=1;
for i:=1 to length(binary) do begin
if (i=1) then pnz:=1 else begin
if( binary[i]=binary[i-1]) and ( binary[i]='1') then SIGN(pnz);
end;
AMI_arr[pred(i)] := (ord(binary[i])-48)*pnz;
if binary[i]='0' then pnz:=1;
end;
writeln('AMI');
for i:=0 to 7 do write(AMI_arr[i],' ');
for i:=0 to 7 do begin
line (getmaxx div 2+(i+1)*20, getmaxy div 2 - 20*(AMI_Arr[i]), getmaxx div 2+(i+1)*20+20, getmaxy div 2 - 20*(AMI_Arr[i]));
if i<7 then line (getmaxx div 2+(i+1)*20+20, getmaxy div 2 - 20*(AMI_Arr[i]),
getmaxx div 2+(i+1)*20+20, getmaxy div 2 - 20*(AMI_Arr[i+1]));
end;
end;
var
f:text;
filename : string;
main_str :string;
begin
Writeln('Entropy and AMI code. ');
Write (' enter file name: '); readln(filename);
// filename :='d:\a.txt';
assign(f,filename);
{$i-} reset(f); {$I+}
if Ioresult<>0 then begin
writeln('I\O Error! Press any key...');
readkey;
halt
end;
readln(f,main_str);
close(f); writeln;
printascii(main_str);
get_data_str(main_str);
writeln(#13#10,'Data size = ', DATA_COUNT);
writeln('Entropy = ', ENTROPY:3:3);
writeln('Data count = ', DATA_COUNT * ENTROPY:3:3);
writeln('press any key...');
readkey;
initialization_graph();
AMI_code (main_str[1]);
readkey;
closegraph();
end.
и вторая...
uses crt, math, graph;
const
HEX_MODE = 16;
DATA_COUNT : integer = 0;
ENTROPY : extended = 0.0;
var
symb : array [0..255] of byte;
function FromDec(n, radix:longint):string;
var s: String;
const
digit: string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod radix)+1]+s;
n:=n div radix;
until n=0;
fromdec:=s;
end;
function printascii (var s:string):string;
var i:byte;
t:string;
begin
t:='';
for i:=1 to length(s) do begin
t:=t+FromDec(ord(s[i]),HEX_MODE);
if i mod 8 =0 then writeln;
end;
result:=t;
end;
procedure initialization_graph ();
var
GD,GM: smallint;
begin
GD:= d8bit;
GM:= m800x600;
initgraph(GD,GM, '');
end;
procedure MAN_code (s:char);
function SIGN(var g:integer):integer;
begin
if g>0 then g *=-1 else g:=g;
end;
var i:integer;
binary : string;
AMI_arr :array[0..13] of integer;
pnz: integer;
begin
for i:=0 to 13 do AMI_arr[i]:=0;
binary := FromDec(ord(s),2);
writeln('BIN symbol [1]: ',binary);
for i:=1 to length(binary) do begin
if binary[i]='1' then begin AMI_arr[2*pred(i)] := 0; AMI_arr[2*pred(i)+1] := 1; end;
if binary[i]='0' then begin AMI_arr[2*pred(i)] := 1; AMI_arr[2*pred(i)+1] := 0; end;
end;
for i:=0 to 13 do begin
line (getmaxx div 2+(i+1)*20, getmaxy div 2 - 20*(AMI_Arr[i]), getmaxx div 2+(i+1)*20+20, getmaxy div 2 - 20*(AMI_Arr[i]));
if i<13 then line (getmaxx div 2+(i+1)*20+20, getmaxy div 2 - 20*(AMI_Arr[i]), getmaxx div 2+(i+1)*20+20, getmaxy div 2 - 20*(AMI_Arr[i+1]));
end;
end;
var
f:text;
filename : string;
main_str :string;
hex_code_str:string;
{---}
pre:string[14];
no:string[2];
addr_to:string[12];
addr_from:string[12];
len_data:string[4];
data:string;
begin
Writeln('Ethernet, IEEE 802.3. ');
Write (' enter file name: '); readln(filename);
// filename :='d:\a.txt';
assign(f,filename);
{$i-} reset(f); {$I+}
if Ioresult<>0 then begin
writeln('I\O Error! Press any key...');
readkey;
halt
end;
readln(f,main_str);
close(f); writeln;
writeln('sources data: ',main_str);
hex_code_str := printascii(main_str);
pre:='AAAAAAAAAAAAAA';
no:= 'AB';
addr_to:= 'FFFFFFFFFFFF';
addr_from:= 'FFFFFFFFFFFF';
len_data:=FromDec(length(main_str),HEX_MODE);
data:=hex_code_str;
writeln('Ethernet frame:');
writeln(pre,' ',no,' ',addr_to,' ',addr_from,' ',len_data,' ',data);
readkey;
initialization_graph();
MAN_code (main_str[1]);
readkey;
closegraph();
end.
Никто не сможет скомпилировать мне их в EXE файлы ?
(компилер FPC 2.0.2)
У меня не компилятора, и качать его я буду примерно час, потом устанавливать и т.п. и. т.д., а нужно то собственно только ради компиляции этих 2 кодов...
Спасибо!
