فارسي اطلاعات Dos در 7 + 2010

[JavanSoft]

نرم افزار قبلي خودم را كه با Xp و D7 شروع كرده بودم به سمت 7 و 2010 بردم .
متاسفانه با توجه به ساختار قديمي سازمانهاي دولتي مرتبط همچنان مجبور بودم كه از اطلاعات توليد شده تحت Dos/Fox با كد پيج ايران سيستم استفاده كنم و انها را به SqlServer منتقل كنم . در Xp/D7 مشكلي نداشتم ولي در 2010/W7 به مشكل جالب يوني كد برخورد كردم !!!
تابع فوق ارتقاء يافته مبدل هاي فارسي است كه در سايت وزين برنامه نويس وجود دارد .
خواهشمندم ضمن (در صورت تمايل) استفاده ، در صورتي كه به نقص و مشكلي برخورد كرديد در همين تاپيك مطح نماييد.
متشكرم





Function ConvertItAlfba(InST:String):String;
Const
Bl = ' ';
Var
Text1,Text2,Text3,AB,Con : String;
A,B : Char;
L,X:Integer;
Begin
InSt:=TrimLeft(InSt);
InSt:=TrimRight(InSt);
Text1:= '';
L:=length(InSt);
Con:='';
for X:= 1 to L Do
Begin
If (InST[X] In ['A'..'Z','a'..'z']) Then
Begin
Result:=InST;
Exit;
End
End;
Text1:=' '+InSt+' ';
Text2:='';
Text3:='';
L:=length(Text1);
for X:= 1 to L Do
Begin
B:='-';
A:=Text1[X];
Case Ord(A) Of

1567,138: a:='_';
139: a:='?';
1670,140: a:='آ';
1688,141: a:='ئ';
1672,142: a:='ء';
1711,143: a:='ا';
8216,144,145:a:='ا';
8217,146: Begin
if Text1[x-1]=' ' Then
Begin
a:='ب';;
B:='-';
End
else
a:='ب';;
End;
8220,147: a:='ب';
8221,148: Begin
if Text1[x-1]=' ' Then
Begin
a:='پ';
B:='-';
End
else
a:='پ';
End;
8226,149: a:='پ';
8211,150: Begin
if Text1[x-1]=' ' Then
Begin
a:='ت';
B:='-';
End
else
a:='ت';
End;
8212,151: a:='ت';
1705,152: Begin
if Text1[x-1]=' ' Then
Begin
a:='ث';
B:='-';
End
else
a:='ث';
End;
8482,153: a:='ث';
1681,154: Begin
if Text1[x-1]=' ' Then
Begin
a:='ج';;
B:='-';
End
else
a:='ج';;
End;
8250,155: a:='ج';
339,156: Begin
if Text1[x-1]=' ' Then
Begin
a:='چ';;
B:='-';
End
else
a:='چ';;
End;
8204,157: a:='چ';
8205,158: Begin
if Text1[x-1]=' ' Then
Begin
a:='ح';
B:='-';
End
else
a:='ح';
End;
1722,159: a:='ح';
160: Begin
if Text1[x-1]=' ' Then
Begin
a:='خ';
B:='-';
End
else
a:='خ';
End;
1548,161: a:='خ';
162: a:='د';
163: a:='ذ';
164: a:='ر';
165: a:='ز';
166: a:='ژ';
167: Begin
if Text1[x-1]=' ' Then
Begin
a:='س';
B:='-';
End
else
a:='س';
End;
168: a:='س';
1726,169: Begin
if Text1[x-1]=' ' Then
Begin
a:='ش';
B:='-';
End
else
a:='ش';
End;
170: a:='ش';
171: Begin
if Text1[x-1]=' ' Then
Begin
a:='ص';
B:='-';
End
else
a:='ص';
End;
172: a:='ص';
173: Begin
if Text1[x-1]=' ' Then
Begin
a:='ض';
B:='-';
End
else
a:='ض';
End;
174: a:='ض';
175: a:='ط';
224: a:='ظ';
1604,1606,225,226:
Begin
if Text1[x-1]=' ' Then
Begin
a:='ع';
B:='-';
End
else
a:='ع';
End;
1605,227,228 : a:='ع';
1607,1608,229,230 :
Begin
if Text1[x-1]=' ' Then
Begin
a:='غ';
B:='-';
End
else
a:='غ';
End;
231,232 : a:='غ';
233: Begin
if Text1[x-1]=' ' Then
Begin
a:='ف';
B:='-';
End
else
a:='ف';
End;
234: a:='ف';
1609,235: Begin
if Text1[x-1]=' ' Then
Begin
a:='ق';
B:='-';
End
else
a:='ق';
End;
236: a:='ق';
1610,237: Begin
if Text1[x-1]=' ' Then
Begin
a:='ك';
B:='-';
End
else
a:='ك';
End;
238: a:='ك';
1611,239: Begin
if Text1[x-1]=' ' Then
Begin
a:='گ';
B:='-';
End
else
a:='گ';
End;
240: a:='گ';
1612,241: Begin
if Text1[x-1]=' ' Then
Begin
a:='ل';
B:='-';
End
else
a:='ل';
End;
242: Begin
a:='ل';
B:='ا';
End;
1614,243: a:='ل';
1615,244: Begin
if Text1[x-1]=' ' Then
Begin
a:='م';
B:='-';
End
else
a:='م';
End;
245: a:='م';
1616,246: Begin
if Text1[x-1]=' ' Then
Begin
a:='ن';
B:='-';
End
else
a:='ن';
End;
247: a:='ن';
1617,248: a:='و';
1618,1574,249: Begin
if Text1[x-1]=' ' Then
Begin
a:='ه';
B:='-';
End
else
a:='ه';
End;
250,251: a:='ه';
252: Begin
if Text1[x-1]=' ' Then
Begin
a:='ي';
B:='-';
End
else
a:='ي';
End;
8206,253: a:='ي';
8207,254: a:='ي';
end;// Case
If B<>'-' Then
AB:=A+B
Else
AB:=A;
if a in ['1'..'0'] Then
Begin
text3:=text3+AB;
if Not(Text1[x+1] in ['1'..'0'] ) Then
Begin
text2:=text3+text2;
text3:='';
End;
end
else
text2:=AB+text2;
end;//for
If Con<>'' Then
Text2:=Text2+Con;
Result:=TrimLeft(TrimRight(Text2));
End;