PDA

View Full Version : تبدیل اطلاعات


HamedRep
یک شنبه 30 اردیبهشت 1386, 20:52 عصر
سلام دوستان .
من یک فایل دارم که تو اون یک سری رکورد از یک سیستم تحت داس وجود داره .
می‌خوام اطلاعات اون رو تبدیل به کدپیچ ویندوز کنم .
کمکم کنید ممنون می‌شم .
mehdi_mohamadi
چهارشنبه 02 خرداد 1386, 07:49 صبح
قبلا" یه تابع در همین سایت واسه تبدیل اطلاعات از داس به ویندوز و ویندوز به داس قرار دادم
mehdi_mohamadi
چهارشنبه 02 خرداد 1386, 08:15 صبح
function WinToDosStr(WinStr:string):string;
var Nflag :boolean;
Ch : Char;
T,N,M,I,J,DosI :integer;
TmpStr,Str1,Str2 :String;
DosSt :String;
begin
DosSt:='';
// M:=length(WinStr);
// for I:=1 to M do
// if ord(winstr[i])=157 then
// WinStr[i]:=' ';
WinStr:=WinStr+' ';
M:=length(WinStr);
for I:=1 to M do
DosSt:=DosSt + #32;
DosI:=M;
Str1:='';
for I:=1 To M do
begin
Nflag:=False;
case WinStr[i] Of
' ' :Begin
Ch:=#32;
end;
'.','0' .. '9'
: begin
Ch:=chr(ord(WinStr[i])+80);
if (WinStr[i])='.' then
ch:=#140;
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'a' .. 'z',
'A' .. 'Z'
: begin
Ch:=WinStr[i];
str1:=str1+ch;
Nflag:=true;
ch:=#0;
end;
'Â' :begin
ch:=#141;
end;
'Æ' :Begin
Ch:=#142;
end;
'Á' :Begin
Ch:=#143;
end;
'Ç' :begin
Ch:=#145;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1 )
)
then
ch:=#144;
end;
'È' : begin
Ch:=#147;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#146;
end;
'' : begin
Ch:=#149;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#148;
end;
'Ê' :begin
Ch:=#151;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#150;
end;
'Ë' :begin
Ch:=#153;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#152
end;
'Ì' :begin
Ch:=#155;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#154
end;
'' :begin
Ch:=#157;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#156;
end;
'Í' :begin
Ch:=#159;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#158;
end;
'Î' :begin
Ch:=#161;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#160;
end;
'Ï' :begin
Ch:=#162;
end;
'Ð' :begin
Ch:=#163;
end;
'Ñ' :begin
Ch:=#164;
end;
'Ò' :begin
Ch:=#165;
end;
'Ž' :begin
Ch:=#166;
end;
'Ó' :begin
Ch:=#168;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
Ch:=#167;
end;
'Ô' :begin
Ch:=#170;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#169;
end;
'Õ' :begin
Ch:=#172;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#171;
end;
'Ö' :begin
Ch:=#174;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#173;
end;
'Ø' :begin
ch:=#175 ;
end;
'Ù' :begin
ch:=#224
end;
'Ú' :begin
Ch:=#227;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1) )
then
ch:=#228;
if ((WinStr[i+1]=' ') or (i=M)) then
if (ch=#228) then
ch:=#225
else
ch:=#226;
end;
'Û' :begin
Ch:=#231;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1) )
then
ch:=#232;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
if (ch=#232) then
ch:=#229
else
ch:=#230;
end;
'Ý' :begin
Ch:=#234;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#233;
end;
'Þ' :begin
Ch:=#236;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#235;
end;
'ß' :begin
Ch:=#238;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#237;
end;
'' :begin
Ch:=#240;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#239 ;
end;
'á' :begin
Ch:=#243;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#241;
end;
'ã' :begin
Ch:=#245;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ') or (WinStr[i+1]='Â')) then
ch:=#244;
end;
'ä' :begin
Ch:=#247;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#246;
end;
'æ' :begin
ch:=#248 ;
end;
'å' :begin
Ch:=#250;
if((WinStr[i-1]=' ')or
(WinStr[i-1]=#157)or
(WinStr[i-1]='Ç')or
(WinStr[i-1]='æ')or
(WinStr[i-1]='Ï')or
(WinStr[i-1]='Ð')or
(WinStr[i-1]='Ñ')or
(WinStr[i-1]='Ò')or
(WinStr[i-1]='Ž')or
(i=1 ))
then
ch:=#251;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#249;
end;
'í' :begin
Ch:=#254;
if ((WinStr[i+1]=#157) or (WinStr[i+1]=' ')) then
ch:=#252;
if (ord(WinStr[i])=236)then
Ch:=#254;
end;
'Ü' :begin
ch:=#139 ;
end;
else
ch:=WinStr[i];
end;
if (Nflag=false) and(ch<>#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;
if (WinStr[i]<>#157) then
begin
DosSt[DosI]:=Ch; Dec(DosI);
end;
str1:='';
end;
end;
if (Nflag=True) and(ch=#0) and (DosI>0 )then
begin
N:=length(str1);
for j:=N downto 1 do
begin
DosSt[DosI]:=str1[j];
Dec(DosI);
end;
end;
WinToDosStr:=copy(DosSt,2,length(DosSt));
end;
function dostowinstriran(DosStr :string):String;
var
N,I :integer;
StrTmp,WinSt:String;
winstr:string;
// EnFlag,OldFlag :boolean;
begin
N:=StrLen(Pchar(DosStr));
WinSt:='';
WinStr:='';
for I:=N DownTo 1 do
begin

case DosStr[i] Of
#32,#127 :Begin
// EnFlag:=True;
WinStr:= ' '+ WinStr ;
end ;
#38 .. #48:
begin
// EnFlag:=True;
WinStr:= WinStr+chr(ord(DosStr[i])) ;
end;
#128 .. #138
: begin
// EnFlag:=True;
WinStr:= WinStr+ chr(ord(DosStr[i])-80) ;
end;
#141 :begin
// EnFlag:=True;
WinStr:= '&Acirc;'+ WinStr ;
end;
#142 :Begin
// EnFlag:=True;
WinStr:='&AElig;'+ WinStr ;
end;
#143 :Begin
WinStr:= '&Aacute;'+ WinStr ;
// EnFlag:=True;
end;
#144..#145 :begin
// EnFlag:=True;
WinStr:= '&Ccedil;'+ WinStr ;
{ if DosStr[i]=#145 then
WinStr:= ' '+ WinStr ;}
end;
#146..#147
: begin
// EnFlag:=True;
WinStr:= '&Egrave;'+ WinStr ;
if DosStr[i]=#146 then
WinStr:= ' '+ WinStr ;
end;
#148..#149
: begin
// EnFlag:=True;
WinStr:= ''+ WinStr ;
if DosStr[i]=#148 then
WinStr:= ' '+ WinStr ;
end;
#150..#151: begin
// EnFlag:=True;
WinStr:= '&Ecirc;'+ WinStr ;
if DosStr[i]=#150 then
WinStr:= ' '+ WinStr ;
end;
#152..#153: begin
// EnFlag:=True;
WinStr:= '&Euml;'+ WinStr ;
if DosStr[i]=#152 then
WinStr:= ' '+ WinStr ;
end;
#154..#155: begin
// EnFlag:=True;
WinStr:= '&Igrave;'+ WinStr ;
if DosStr[i]=#154 then
WinStr:= ' '+ WinStr ;
end;
#156..#157: begin
// EnFlag:=True;
WinStr:= ''+ WinStr ;
if DosStr[i]=#156 then
WinStr:= ' '+ WinStr ;
end;
#158..#159: begin
// EnFlag:=True;
WinStr:= '&Iacute;'+ WinStr ;
if DosStr[i]=#158 then
WinStr:= ' '+ WinStr ;
end;
#160..#161: begin
// EnFlag:=True;
WinStr:= '&Icirc;'+ WinStr ;
if DosStr[i]=#160 then
WinStr:= ' '+ WinStr ;
end;
#162 :begin
// EnFlag:=True;
WinStr:= '&Iuml;'+ WinStr ;
end;
#163 :begin
// EnFlag:=True;
WinStr:= '&ETH;'+ WinStr ;
end;
#164 :begin
// EnFlag:=True;
WinStr:= '&Ntilde;'+ WinStr ;
end;
#165 :begin
// EnFlag:=True;
WinStr:= '&Ograve;'+ WinStr ;
end;
#166 :begin
// EnFlag:=True;
WinStr:= 'Ž'+ WinStr ;
end;
#167..#168 :begin
// EnFlag:=True;
WinStr:= '&Oacute;'+ WinStr ;
if DosStr[i]=#167 then
WinStr:= ' '+ WinStr ;
end;
#169..#170 :begin
// EnFlag:=True;
WinStr:= '&Ocirc;'+ WinStr ;
if DosStr[i]=#169 then
WinStr:= ' '+ WinStr ;
end;
#171..#172 :begin
// EnFlag:=True;
WinStr:= '&Otilde;'+ WinStr ;
if DosStr[i]=#171 then
WinStr:= ' '+ WinStr ;
end;
#173..#174 :begin
// EnFlag:=True;
WinStr:= '&Ouml;'+ WinStr ;
if DosStr[i]=#173 then
WinStr:= ' '+ WinStr ;
end;
#175..#176 :begin
// EnFlag:=True;
WinStr:= '&Oslash;'+ WinStr ;
// if DosStr[i]=#175 then
// WinStr:= ' '+ WinStr ;
end;
#224 :begin
// EnFlag:=True;
WinStr:= '&Ugrave;'+ WinStr ;
end;
#225..#228 :begin
// EnFlag:=True;
WinStr:= '&Uacute;'+ WinStr ;
if DosStr[i]=#225 then
WinStr:= ' '+ WinStr ;
end;
#229..#232 :begin
// EnFlag:=True;
WinStr:= '&Ucirc;'+ WinStr ;
if DosStr[i]=#229 then
WinStr:= ' '+ WinStr ;
end;
#233..#234 :begin
// EnFlag:=True;
WinStr:= '&Yacute;'+ WinStr ;
if DosStr[i]=#233 then
WinStr:= ' '+ WinStr ;
end;
#235..#236 :begin
// EnFlag:=True;
WinStr:= '&THORN;'+ WinStr ;
if DosStr[i]=#235 then
WinStr:= ' '+ WinStr ;
end;
#237..#238 :begin
// EnFlag:=True;
WinStr:= '&szlig;'+ WinStr ;
if DosStr[i]=#237 then
WinStr:= ' '+ WinStr ;
end;
#239..#240 :begin
// EnFlag:=True;
WinStr:= ''+ WinStr ;
if DosStr[i]=#239 then
WinStr:= ' '+ WinStr ;
end;
#241..#243 :begin
// EnFlag:=True;
WinStr:= '&aacute;'+ WinStr ;
if DosStr[i]=#241 then
WinStr:= ' '+ WinStr ;
if DosStr[i]=#242 then
WinStr:= '&Ccedil;'+ WinStr ;
end;
#244..#245 :begin
// EnFlag:=True;
WinStr:= '&atilde;'+ WinStr ;
if DosStr[i]=#244 then
WinStr:= ' '+ WinStr ;
end;
#246..#247 :begin
// EnFlag:=True;
WinStr:= '&auml;'+ WinStr ;
if DosStr[i]=#246 then
WinStr:= ' '+ WinStr ;
end;
#248 :begin
// EnFlag:=True;
WinStr:= '&aelig;' + WinStr ;
end;
#249..#251 :begin
// EnFlag:=True;
WinStr:= '&aring;'+ WinStr ;
if DosStr[i]=#249 then
WinStr:= ' '+ WinStr ;
end;
#252..#254 :begin
// EnFlag:=True;
WinStr:= '&iacute;'+ WinStr ;
if DosStr[i]=#252 then
WinStr:= ' '+ WinStr ;
end;
#139 :begin
// EnFlag:=True;
WinStr:= '&Uuml;'+ WinStr ;
end
else begin
// EnFlag:=True;
WinStr:= WinStr + DosStr[i] ;
end;
end; // End of case
end; // End Of for I:=N DownTo 1 do

N:=Length(WinStr);
StrTmp:='';
for I:=1 To N do
StrTmp:=WinStr[i] + StrTmp;
dostowinstriran:=strtmp;
//DosToWinStr:=winstr;
end;