CompareType = (Less, Equal, Greater);

Var

Lon, Lon2: LongInt;

Serv: String[255];

1. Procedure Delay(MilliSec: LongInt);

{задержка времени на MilliSec миллисекунд}

Var k: LongInt;

begin

k:=GetTickCount; {в модуле Windows.pas}

While GetTickCount<(MilliSec+k) do ;

end;

2. Function Ctrl_ Shift_Down(i: byte): boolean;

{Нажата ли одна из этих клавиш Ctrl – 1, Shift – 2}

var

ShiftState: TShiftState;

j: LongInt;

begin

Result:=false;

Case i of

1: j:= VK_CONTROL;

2: j:= VK_SHIFT;

end;

ShiftState := KeyDataToShiftState(j);

Case i of

1: Result:= (ssCtrl in ShiftState);

2: Result:= (ssShift in ShiftState);

end;

end;

3. Function CtrlDown: boolean;

{нажата ли клавиша Ctrl}

begin

Result:=Ctrl_ Shift_Down(1);

end;

4. Function ShiftDown: boolean;

{нажата ли клавиша Shift}

begin

Result:=Ctrl_Shift_Down(2);

end;

5. Function Profit(Expend, Price: Real): Real;

{рентабельность=(цена - затраты)/затраты*100}

begin

if (Expend<>0) then Result:= (Price/Expend-1.0)*100.0

else Result:= 1.e5;

end;

6. Procedure Warn1(S: Variant);

{Окно с Variant-значением, например Warn1('Процесс закончен')}

begin

MessageDlg(S, mtInformation, [mbOk], 0);

Screen.ActiveForm.Refresh;

End;

7. Procedure Warn4(s1,s2,s3,s4: String);

{то же , что Warn1, но в 4 строки}

var i,j: byte;

begin

i:=Length(s1); j:=i;

i:=Length(s2);

if (i>j) then j:=i;

i:=Length(s3);

if (i>j) then j:=i;

i:=Length(s4);

if (i>j) then j:=i;

Warn1(Center(s1,j)+''#13#10+''+Center(s2,j)

+''#13#10''+Center(s3,j)+''#13#10+''+Center(s4,j));

end;

8. Function DaNet(S: String): boolean;

{Окно. Предназначено для вопроса, на который можно ответить, щелкнув по одной из кнопок "Да" или "Нет"}

begin

DaNet:=MessageDlg(S, mtConfirmation, [mbYes, mbNo], 0)=mrYes;

Screen.ActiveForm.Refresh;

end;

9. Function DaNet4(s1,s2,s3,s4: String): boolean;

{Окно. То же, что DaNet, только в 4 строки}

begin

DaNet4:=MessageDlg(Trim(s1)+''#13#10+''+Trim(s2)+''#13#10''+Trim(s3)

+''#13#10+''+Trim(s4),mtConfirmation,[mbYes, mbNo], 0)=mrYes;

Screen.ActiveForm.Refresh;

end;

10. Function InOtrReal(i,a,b: real): boolean;

{Если i в орезке [a, b], то возвращает True}

begin

Result:=(i>=a) and (i<=b);

end;

11. Function ExitK: boolean;

{стандартный вопрос о выходе}

begin

ExitK:=DaNet('Выход ?');

end;

12. Function Pos2(SubS, S: String; StartPos: byte): boolean;

{входит ли SubS в S начиная с StartPos}

begin

Lon:=Pos(SubS,S);

Result:= (Lon > 0) and (StartPos = Lon);

end;

13. Function ChStr(Ch: Char; d: Word): String;

{создает строку из символа Ch, повторенного d раз}

begin

if d>0 then

begin

SetLength(Result,d);

FillChar(Result[1],d,Ch);

end;

end;

14. Function Prop(d: Word): String;

{создает строку из d пробелов}

begin

Result:=ChStr(' ',d);

end;

15. Function Pad(s: String; d: Word): String;

{вставляет справа от строки пробелы, добирая ее до длины d}

begin

Serv:=s;

Lon:=Length(s);

If (d>Lon) then Serv:=s+Prop(d-Lon);

Result:=Serv;

end;

16. Function PadCopy(s: String; n,d: Word): String;

{копирует из s начиная с позиции n строку длины d. В случае меньшей строки добирает ее до длины d}

begin

Serv:=Copy(s,n,d);

if Length(Serv) < d then Serv:=Pad(Serv,d);

Result:=Serv;

end;

17. Function LeftPad(s: String; d: Word): String;

{вставляет слева от строки пробелы, добирая ее до длины d}

begin

Serv:=s;

Lon:=Length(s);

if (d>Lon) then Serv:=Prop(d-Lon)+s;

Result:=Serv;

end;

18. Function Center(s: String; d: Word): String;

{вставляет слева и справа от строки поровну пробелы, добирая ее до длины d}

begin

Serv:=s;

Lon:=Length(s);

Lon2:=Round(0.5*(d-Lon));

if (d>Lon) then Serv:=Prop(Lon2)+s+Prop(d-Lon2);

Result:=Serv;

end;

19. Function CompStrings(s1,s2: String): CompareType;

{сравнение строк: s1<s2 - Less, s1=s2 - Equal, s1>s2 - Greater}

begin

if (s1<s2) then CompStrings:=Less

else

if (s1>s2) then CompStrings:=Greater

else

CompStrings:=Equal;

end;

20. Function CompReal(r1,r2: Real): CompareType;

{сравнение вещественных чисел}

begin

if (r1<r2) then Result:=Less

else

if (r1>r2) then Result:=Greater

else

Result:=Equal;

end;

21. Procedure IncRe(Var r: Real; h: real);

begin

r:=r+h;

end;

22. Function LongToStr(L: LongInt; d: byte): String;

{конвертирует целое в строку длины d}

begin

Str(L,Serv);

Result:=LPad(Serv,d);

end;

23. Function Long2Str(L: LongInt): String;

{конвертирует целое в строку}

begin

Str(L,Serv);

Result:=Serv;

end;

24. Function StrLong(st: String): LongInt;

{конвертирует строку в целое }

begin

Val(Trim(st),Lon,Code);

Result:=Lon; end;

25. Function Str2Long(st: String; Var L: LongInt): boolean;

{конвертирует строку в целое. Возвращает True в случае успеха}

begin

Val(Trim(st),L,Code);

Result:=(Code=0);

end;

26. Function RealToStr(R: Real; Posle: byte): String;

{Конвертирует Real в строку, Posle – количество символов в дробной части R}

begin

Str(R:20:Posle,Serv);

RealToStr:=Trim(Serv);

end;

 

27. Function Slash(Dir: String): String;

{ставит в конец пути символ '\'}

begin

Serv:=Trim(Dir);

if (Serv[Length(Serv)]<>'\') then Result:=Serv+'\'

else Result:=Serv;

end;

28. Function ChWinDos(Ch: Char): Char;

{преобразует русский Windows-символ в русский DOS-символ}

Var i,j: byte;

begin

i:=Ord(Ch);

Case i of

168: {Ё} j:=240;

184: {ё} j:=241;

192..255: if (i>239) then j:=i-16 else j:=i-64

else j:=i;

end;

Result:=Char(j);

end;

29. Function ChDosWin(Ch: Char): Char;

{преобразует русский DOS-символ в русский Windows-символ}

Var i,j: byte;

begin

i:=Ord(Ch);

Case i of

240: {Ё} j:=168;

241: {ё} j:=184;

128..175: j:=i+64;

224..239: j:=i+16

else j:=i;

end;

Result:=Char(j);

end;

30. Function StrWinDos(st: String): String;

{преобразует русскую Windows-строку в русскую DOS-строку}

Var

n, i: byte;

s: ^String;

begin

New(s);

n:=Length(st);

s^:= '';

if (n>0) then

for i:=1 to n do

s^:= s^+ChWinDos(st[i]);

Result:=s^;

Dispose(s);

end;

31. Function StrDosWin(s: String): String;

{преобразует русскую DOS-строку в русскую Windows-строку}

Var

n,i: byte;

s: ^String;

begin

New(s);

n:=Length(st);

s^:= '';

if (n>0) then

for i:=1 to n do

s^:= s^+ChDosWin(st[i]);

Result:=s^;

end;

32. Function InputStr(const Prompt: String; Var s: String; IsParol: byte): boolean;

{ввод строки. Prompt – пояснение, s – вводимая строка,

isParol=1, если засекреченный ввод, иначе видимый}

begin

Result:=

KdnInputQuery('Ввод строки', Prompt, s, clBlack, (IsParol=1));

end;

33. Function ParolControl(RealParol: String): boolean;

{возвращает True, если введенная строка совпадает с RealParol}

var

b,h: boolean;

i: byte;

begin

St:='';

i:=0;

b:=false;

Repeat

Inc(i);

h:=InputStr('Введите пароль ...',St,1);

if h then b:= (St=RealParol);

if not b and h then Warn1('Ошибка');

Until b or (i=3) or (not h);

Result:=b;

end;

34. Function ExistSubDir(SubDir:String; Dir: tPathStr):boolean;

{устанавливает наличие субдиректории SubDir внутри директории Dir. Например, в D:\DIR0001 субдиректории BAR }

begin

Result:=DirectoryExists(Slash(SubDir)+Dir);

end;

35. Function GetFileSize(const FileName: string): LongInt;

{размер файла}

var Sr: TSearchRec;

begin

if FindFirst(ExpandFileName(FileName), faAnyFile, Sr) = 0 then

Result := Sr.Size

else Result := -1;

end;

36. Function FileDateTime(const FileName: string): System.TDateTime;

{время создания файла FileName, например:

s:= DateTimeToStr(FileDateTime('c:\KdnBread\Bread.exe'))}

begin

Result := FileDateToDateTime(FileAge(FileName));

end;

37. Function HasAttr(const FileName: string; Attr: Word): Boolean;

{имеет ли файл FileName атрибут Attr}

begin

Result := (FileGetAttr(FileName) and Attr) = Attr;

end;

38. Procedure AppendText(Var f: Text; nF: String);

{открывает текстовой файл для добавления строк}

begin

Assign(f,nF);

if KdnFS(nF,1)>0 then Append(f) else Rewrite(f);

end;

39. Procedure AppendToText(nF,s: String);

{добавляет строку в конец текстового файла}

Var f: TextFile;

begin

AppendText(f, nF);

Writeln(f,s);

CloseFile(f);

end;

40. Procedure KdnExec(Command: String);