program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils,windows,StrUtils;
var
MyFile : TextFile;
MyText : String;
Input:string;
output1,output2:string;
echo:boolean;
MS:TMemoryStatus;
p : COORD;
nChars : DWORD;
buf_info : CONSOLE_SCREEN_BUFFER_INFO;
console : Cardinal;
TextAttr: Byte;
LastMode: Word;
procedure color(text,bcgrnd:byte);
begin
LastMode := TextAttr;
TextAttr := (TextAttr and $F0) or (text and $0F);
SetConsoleTextAttribute(console, TextAttr);
LastMode := TextAttr;
TextAttr := (TextAttr and $0F) or ((bcgrnd shl 4) and $F0);
SetConsoleTextAttribute(console, TextAttr);
end;
//---------------------inter32- interpretacja tekstu----------------------------
procedure inter32;
var
i,i2,i3:integer;
stro:string;
begin
i:=0;
i2:=0;
i3:=0;
stro:='';
output1:='';
output2:='';//zerowanie
while (length(input)>i) do
begin
I:=I+1;
if input[i]=#32 then break; //wykrycie I spacji
end;
if input[i]=#32 then i:=i-1;
while i2<i do begin
i2:=i2+1;
stro:=stro+input[i2];//ekstrakcja pierwszego słowa -polecenia
output1:=ansiuppercase(stro) ; //główne polecenie
end;
if input[i+1]=#32 then i3:=i+2;
output2:=MidStr(input,i3,length(input)-i3+1) ;//pozostałe znaki
// tu już jest ok !
end;
//----------------------------------------------------------------------------
procedure loadfrom;
var i4,i5,c3,c4:integer;
c1,c2:byte;
s,s2:string;
label koniec;
begin
i4:=0;
i5:=0;
if ((ParamCount>=1) and (FileExists(ParamStr(1))=true))
then
begin
AssignFile(MyFile, ParamStr(1));
Reset(MyFile);
while not eof(MyFile) do
begin
Readln(MyFile, MyText);
//---------------------Wykonywanie poleceń--------------------------------------
// writeln(MyText);
input:=MyText;
inter32;
//----------------------polecenia-------------------------------------------
if output1='TEXT' then if echo then writeln('Text '+output2) else writeln(output2);
if output1='STOP' then begin writeln('Press enter to continue !'); readln; end;
if output1='STOP_M' then readln;
if output1='ECHO' then echo:=true;
if output1='SLEEP' then sleep(strtoint(output2));
if output1='NOECHO' then echo:=false;
if output1='EXE' then WinExec(pchar(output2),sw_normal);
if output1[1]='|' then goto koniec; //komentarz
if output1='BEEP' then begin
while length(output2)>i5 do
begin
i5:=i5+1;
if output2[i5]='_' then break;
end;
S2:=output2;
SetLength(s2,i5-1);
c3:=strtoint(s2);//strtoint(MidStr(s,7,length(output2)-6)) ;
c4:=strtoint(MidStr(output2,length(s2)+2,length(output2)));
if echo then writeln('Beep '+inttostr(c3)+'_'+inttostr(c4));
windows.beep(c3,c4);
i5:=0;
c3:=0;
c4:=0;
end;
if output1='CLEAR' then begin
p.X := 0;
p.Y := 0;
GetConsoleScreenBufferInfo(Console, buf_info);
FillConsoleOutputCharacter(Console, ' ', buf_info.dwSize.X * buf_info.dwSize.Y, p, nChars);
GetConsoleScreenBufferInfo(Console, buf_info);
FillConsoleOutputAttribute(Console, buf_info.wAttributes, buf_info.dwSize.X * buf_info.dwSize.Y, p, nChars);
SetConsoleCursorPosition(Console, P);
end;
if output1='TESTM' then
begin
MS.dwLength:=sizeof(ms);
GlobalMemoryStatus(ms);
writeln('Used memory : '+inttostr(ms.dwMemoryLoad)+' %');
writeln('Total Physical Memory : '+inttostr(ms.dwToTalPhys)+' B');
writeln('Free Physical Memory : '+inttostr(ms.dwAvailPhys)+' B');
writeln('Total memory paged : '+inttostr(ms.dwTotalPageFile)+' B');
writeln('Free memory paged : '+inttostr(ms.dwAvailPageFile)+' B');
writeln('Total virtual memory: '+inttostr(ms.dwTotalVirtual)+' B');
writeln('Free virtual memory:'+inttostr(ms.dwAvailVirtual)+' B');
end;
if output1='COLOR' then begin
while length(output2)>i4 do
begin
i4:=i4+1;
if output2[i4]='_' then break;
end;
S:=output2;
SetLength(s,i4-1);
c1:=strtoint(s);//strtoint(MidStr(s,7,length(output2)-6)) ;
c2:=strtoint(MidStr(output2,length(s)+2,length(output2)));
if echo then writeln('Color '+inttostr(c1)+'_'+inttostr(c2));
if NOT ((c1>=255)and(c2>=255)) then color(c1,c2)else if echo then writeln('Invalid color value(0...255)');
i4:=0;
end;
end;
end;
Koniec:
CloseFile(MyFile);
end;
begin
console := GetStdHandle(STD_OUTPUT_HANDLE);
echo:=true;
loadfrom;
end.
Tak wygląda cały kod. (WIEM, wygląda , jakby ktoś pijany go pisał,ale nie robiłem w nim jeszcze porządku). Problem : jak mogła by wyglądać procedura do formatowania , jak "GOTO" -przeskok do etykiet w kodzie . I jeszcze jedno. Program na bank nie powinien odpalić się w DOS-ie ,więc co mu jest potrzebne ,aby był "samowystarczalny".