Модератор: Модераторы
Vadim писал(а):Метод научного тыка Вам поможет разобраться.
toxin писал(а):пака
toxin писал(а):Да может у каво есть архивы исходников на паскале, а то пака различать код не сильно получаетсо =(
Код: Выделить всё
uses crt;
var i,j,k,l:integer;
x,z:char;
s:string;
begin randomize; clrscr;
j:=1;
while j<>0 do begin
textcolor(13);
write('Автор- ');textcolor(15);writeln('B4rr4cuda');
textcolor(9);
writeln('Дата создания - 21.6.02');
textcolor(2);
writeln('Действие: Эта прога генерирует 1-255 -значные пароли из случайных символов');
Textcolor(14);
writeln('Для выхода нажмите 0 и два раза клавишу Enter');
textcolor(15);
writeln('Кол-во символов?');
readln(j);
while length(s)<j do begin
k:=random(88)+37;
if (k<>96) and (k<>94) then
s:=s+chr(k);
l:=random(16);
if (l<12) and (l>6) then begin
k:=random(23)+32;
if (k<>37) and (k<>39) then
s:=s+chr(k);
end; end;
while length(s)>j do delete(s,j+1,1);
writeln('Ваш пароль: ',s);
readkey;
clrscr;
s:='';
end;
end.
Код: Выделить всё
uses crt;
var K,i,j,kl:integer;
s1,s2,s3:string;
fa : record
name:string[20];
d,m,g:byte;
adress:record
street:string[30];
num,kv:word;
end{of adress};
Tel:String[20];
end{of rec};
begin
clrscr;
with fa do begin
write('Введите имя:');
readln(name);
write('Введите День,месяц,год рождения:');
readln(D,m,g);
with adress do begin
write('Введите Улицу:');
readln(Street);
write('Введите №: Дома: ');
readln(Num);
write('Введите Квартиру:');
readln(kv);
end;
write('Введите tel:');
readln(tel);
end; i:=0;
{CLRSCR;}
repeat CLRSCR;
wRITE('Введите № поля ');
Readln(k);
with fa do
case k of
1:writeln('имя:',name);
2:writeln('День,месяц,год рождения:',d,' ',m,' ',g);
3:writeln('Улица:',adress.street);
4:writeln('Дом:',adress.num);
5:writeln('Kv:',adress.kv);
6:writeln('Tel:',tel);
end; i:=i+1; readkey;
until i>10;
readkey;
end.Код: Выделить всё
program list; uses crt;
type tip=Integer;
Tnod=^nod;
nod=record info:tip;
next:Tnod;
end;
function Dln(var Lis:Tnod):integer;
VAR c:Tnod; i:integer;
begin i:=0; c:=Lis;
while c<>nil do begin c:=c^.next; inc(i) end;
Dln:=i;
end; { of Dln }
procedure Sozd(Var Lis: Tnod);
var lit:char; c,n:Tnod;
begin new(Lis); Lis^.next:=nil;
write(' Информация: '); read(Lis^.info); c:=Lis;
repeat write(' Ещё? (d/n) '); Lit:=ReadKey;
if lit in ['N','n'] then exit
else
begin new(n);
write(' Информация: '); read{ln}(n^.info);
c^.next:=n; c:=n; n^.next:=nil;
end;
until upcase(lit)='N'; writeln;
end; {of Sozd}
procedure PrintRec1(c:Tnod);
Begin
If c^.Next<>nil Then PrintRec1(c^.Next); {Else} write(' ',c^.info)
End; { of PrintRec1 }
procedure PrintRec2(c:Tnod);
Begin write(' ',c^.info);
If c^.Next<>nil Then PrintRec2(c^.Next); {Else}
End; { of PrintRec1 }
procedure Print(var Lis:Tnod; nv: Word);
Const Tx: Array [1..2] Of String = ('прямой вывод','обратный вывод');
VAR c:Tnod; L: Integer;
begin L:=Dln(Lis); write(Tx[nv],' Элементы: '); c:=Lis;
If L<=0 Then Writeln('отсутствуют!!!') Else
If nv=1 then PrintRec2(c) else PrintRec1(c);
writeln(#13#10' Длина списка: ',L);
end; { of Print }
procedure insrt(Var Lis:Tnod);
var Poz,i:integer; temp:Tnod; el:tip;
VAR c,n:Tnod;
begin write('элемент: ');readln(el); write(' позиция: '); readln(Poz);
if poz=1 then
begin new(n); n^.info:=el;
n^.next:=Lis; Lis:=n; writeln;
end
else
begin i:=2; c:=Lis;
while i<>poz do
begin c:=c^.next; inc(i) end;
new(n); n^.info:=el; n^.next:=c^.next; c^.next:=n;
end; writeln;
end; {of insrt 1/03/2000}
procedure dlt(Ps:integer; var P:Tnod);
var i,L: integer; S,C,R: Tnod;
begin write(' позиция: '); readln(Ps);
if Ps=1 then {Del1(P)}
begin
NEW(R); R:=P; P:=P^.NEXT; R^.Next:=Nil; DISPOSE(R)
end else
begin i:=2; C:=P; L:=Dln(C);
while (i<>Ps) and (i<L) do begin C:=C^.next; inc(i); end;
{If i<L Then} begin S:=C^.next; C^.next:=S^.next; DISPOSE(S) end;
end;
end; { of dlt }
procedure init(var Lis: Tnod; Elem: Tip);
VAR c,n:Tnod;
begin
n^.info:=elem; n^.next:=c^.next; c^.next:=n
end; { of Init }
VAR Lis:Tnod; el,elem:tip; f,l,Ps:integer;
BEGIN clrscr; (* init(Lis,-1{ELEM}); *)
repeat writeln;
writeln(' 1:ПечатьПр 2:Создать 3:ПечатьОб 4:Вставка 5:Удалить 0:Выйти');
write(' Выбери - от 0 до 5: '); readln(f);
case f of
1: Print(Lis,1); 2: Sozd(Lis); 3: Print(Lis,2); 4: insrt(Lis); 5: dlt(Ps,Lis);
end;
until f=0;
END. {1/03/2000} Код: Выделить всё
Program minimum;
const n=5;
type vector=array [1..n] of real;
function min(a:vector;i:integer;x:integer;var minim:real):real;
var ix:integer;
begin
ix:=i;
if (ix=1) and (ix<>x) then ix:=x;
if i>n then exit;
if a[ix]<minim then
begin
minim:=a[ix];
min:=min(a,ix+1,x,minim);
end else min:=min(a,ix+1,x,minim);
min:=minim;
end;
var a:vector;
minim:real;
i,x:integer;
begin
for i:=1 to n do
begin
writeln('Введите элемент вектора N:',i);
readln(a[i]);
end;
writeln('Введите элемент х с которого начинать проверку:');
readln(x);
writeln('minimum=',min(a,1,x,a[x]):5:2);
end. Код: Выделить всё
Program TwoToOne;
var textfile1,textfile2,textfile3:text;
s,path1,path2:string;
begin
writeln('Введите путь к первому файлу:');
readln(path1);
writeln('Введите путь ко второму файлу:');
readln(path2);
assign(textfile1,path1);
assign(textfile2,path2);
assign(textfile3,'new.txt');
reset(textfile1);
reset(textfile2);
rewrite(textfile3);
while not eof(textfile1) do
begin
readln(textfile1,s);
writeln(textfile3,s);
end;
while not eof(textfile2) do
begin
readln(textfile2,s);
writeln(textfile3,s);
end;
close(textfile1);
close(textfile2);
close(textfile3);
end.
