ANTICHAT.XYZ    VIDEO.ANTICHAT.XYZ    НОВЫЕ СООБЩЕНИЯ    ФОРУМ  
Баннер 1   Баннер 2
Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей. Здесь обсуждаются безопасность, программирование, технологии и многое другое. Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
Вернуться   Форум АНТИЧАТ > Программирование > С/С++, C#, Delphi, .NET, Asm
   
 
 
Опции темы Поиск в этой теме Опции просмотра

Помогите перевести с pascal -> C
  #1  
Старый 24.06.2009, 21:05
Аватар для advokat.holy
advokat.holy
Новичок
Регистрация: 05.03.2008
Сообщений: 11
Провел на форуме:
46977

Репутация: 1
Exclamation Помогите перевести с pascal -> C

Здрасте! У меня такая вот проблема, надо сдать лабу.
Она у меня написана на паскале, мне надо перевести ее на сишку.
вот кол: (программа проверка орфографии)
Uses CRT;
Const NameDict = 'dict.slo';
Max = 100;

Var Word1, Word2 : String[30];
FileDict : Text;
M : Array [1..Max] Of String[30];
I,L : Word;
Eq : Boolean;

Function NonEqualLength(S1, S2 : String) : Boolean;
Var I : Word;
F,R : Boolean;

Begin
F := True;
{ begin }
While F Do
Begin
If (S1[1] = S2[1])
Then
Begin
Delete(S1, 1, 1);
Delete(S2, 1, 1);
End
Else F := False;
End;

F := True;
{ end }
While F Do
Begin
If (S1[Length(S1)] = S2[Length(S2)])
Then
Begin
Delete(S1, Length(S1), 1);
Delete(S2, Length(S2), 1);
End
Else F := False;
End;

If (Length(S1) = 0) OR (Length(S2) = 0)
Then R := True
Else R := False;

NonEqualLength := R;
End;

Function EqualLength(S1, S2 : String) : Boolean;
Var F : Boolean;
I, R, Error1, Error2 : Word;

Begin
R := 0;
For I := 1 To Length(S1) Do
Begin
If S1[I] <> S2[I] Then
Begin
R := R + 1;
If R = 1 Then Error1 := I;
If R = 2 Then Error2 := I;
End;
End;

F := False;
If R = 0
Then F := True;

If R = 1
Then F := True;

If ( (R = 2) and (S1[Error1] = S2[Error2]) and (S1[Error2] = S2[Error1]) )
Then F := True;

EqualLength := F;
End;

Function UpperCaseRus(RusChar : Char) : Char;
Begin
Case RusChar Of
'*'..'Ї': UpperCaseRus := Chr(Ord(RusChar)-32);
'а'..'п': UpperCaseRus := Chr(Ord(RusChar)-80);
'с' : UpperCaseRus := 'р';
Else UpperCaseRus := UpCase(RusChar);
End;
End;

Function UpString(S : String) : String;
Var I : Byte;
NewString : String;
Begin
NewString:='';
For I:=1 To Length(S) Do NewString := NewString + UpperCaseRus(S[I]);
UpString:=NewString;
End;

Procedure Orphography (W1, W2 : String);
Var F : Boolean;
Begin
F := False;

If (Length(W1) = Length(W2))
Then F := EqualLength (W1, W2);

If ( Abs(Length(W1)-Length(W2)) = 1)
Then F := NonEqualLength (W1, W2);

If (F)
Then
Begin
M[L] := W1;
Inc(L);
End;
End;

Begin
ClrScr;
For I := 1 To Max Do M[I] := '';
L := 1;

Write('‚ўҐ¤ЁвҐ б«®ў® ¤«п Їа®ўҐаЄЁ: ');
ReadLn(Word2);
Word2 := UpString(Word2);

Eq := True;
Assign (FileDict, NameDict);
Reset (FileDict);
While ( Not(EOF(FileDict)) and Eq) Do
Begin
ReadLn(FileDict, Word1);
Word1 := UpString(Word1);
If Word1 = Word2 Then Eq := False;
Orphography (Word1, Word2);
End;
Close (FileDict);

If Not(Eq)
Then
WriteLn ('Ћв«Ёз*®! ’*Є®Ґ б«®ў® Ґбвм ў б«®ў*аҐ!')
Else
If L <> 1
Then
Begin
WriteLn ('‚®§¬®¦*® б«®ў® **ЇЁб**® *Ґ ўҐа*®.');
WriteLn ('‚*аЁ**вл §*¬Ґ*л: ');
For I := 1 To L Do Write(M[I], ' ');
WriteLn;
End;
{ Else WriteLn ('ЌҐЁ§ўҐбв*®Ґ б«®ў®. ?§ўЁ*ЁвҐ.');
}

WriteLn('... **¦¬ЁвҐ Є«*ўЁиг ...');
ReadLn;
End.
 
Ответить с цитированием
 



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите перевести прогу с паскаля в С++ WeReWoLf777 С/С++, C#, Delphi, .NET, Asm 6 24.03.2009 21:55
Помогите первести HEx код ! ExOrientaLux ICQ 10 14.11.2006 18:43
помогите с Linux piavka *nix 11 20.10.2006 11:05
Народ!!! Помогите НАМ!!! Помогите покончить с беспределом!!! Monah Чаты 7 24.08.2005 07:06
Продаю самые Красивые номера. Красивые 5,6 знаки. Кирпич ICQ - Покупка, продажа 3 09.04.2004 18:45



Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
 


Быстрый переход




ANTICHAT.XYZ