1 unit Transvar;
2
3 {Important: The input variables may be changed after executing this functions}
4 {----------------------------------------------------------------------------}
5
6 interface
7 function Int2P(i:longint):PChar;
8 function P2Int(p:PChar):longint;
9 function Real2P(i:real):PChar;
10 function P2Real(p:PChar):real;
11 function Str2P(st:string):PChar;
12 function P2Str(p:PChar):string;
13 function FileDirectory(st:string):string;
14 function FileParameters(st:string):string;
15 function UpStr(st:string):string;
16 function Int2Hex(w:longint):string;
17 function Hex2Int(st:string):longint;
18 function Int2Bin(w:longint;bitcount:byte):string;
19 {$IFDEF MSDOS}
20 function FileNameComp(Filename,JokerFile:string):boolean;{Nur Dateinamen}
21 {$ENDIF}
22 {$IFDEF WINDOWS}
23 function FileNameComp(Filename,JokerFile:string):boolean;{Nur Dateinamen}
24 {$ENDIF}
25 {$IFDEF MSDOS}
26 function GetPathEnvironmentFile(Filename:string):string;
27 {$ENDIF}
28 implementation
29
30 {$IFDEF MSDOS}
31 uses Dos;
32 {$ENDIF}
33 {$IFDEF WINDOWS}
34 uses WinDos,Strings;
35 {$ENDIF}
36
37 const HexStr:string[16]='0123456789ABCDEF';
38 function Int2P(i:longint):PChar;
39 var st:string;
40 begin
41 Str(i,st);
42 Int2P:=Str2P(st);
43 end;
44 function P2Int(p:PChar):longint;
45 var chk:integer;
46 erg:longint;
47 begin
48 Val(P2Str(p),erg,chk);
49 if chk<>0 then P2Int:=0 else P2Int:=erg;
50 end;
51 function Real2P(i:real):PChar;
52 var st:string;
53 begin
54 Str(i,st);
55 Real2P:=Str2P(st);
56 end;
57 function P2Real(p:PChar):real;
58 var chk:integer;
59 erg:real;
60 begin
61 Val(P2Str(p),erg,chk);
62 if chk<>0 then P2Real:=0 else P2Real:=erg;
63 end;
64 function Str2P(st:string):PChar;
65 var l:byte;
66 begin
67 l:=length(st);
68 Move(st[1],st[0],l);
69 st[l]:=#0;
70 Str2P:=@st;
71 end;
72 function P2Str(p:PChar):string;
73 var st:string;
74 l:word;
75 begin
76 l:=0;while p[l]<>#0 do inc(l);
77 if l>255 then l:=255;
78 Move(p[0],st[1],l);st[0]:=chr(l);
79 P2Str:=st;
80 end;
81 function FileDirectory(st:string):string;
82 var tmp:string;
83 a:byte;
84 begin
85 a:=Pos(' ',st);if a=0 then
86 a:=length(st);while (st[a]<>'\')and(a>0) do dec(a);
87 if a=0 then FileDirectory:='\'
88 else
89 begin
90 tmp:=Copy(st,1,pred(a));
91 if Pos('\',st)=0 then tmp:=tmp+'\';
92 FileDirectory:=tmp;
93 end;
94 end;
95 function FileParameters(st:string):string;
96 var tmp:string;
97 spp,slp:byte;
98 begin
99 spp:=Pos(' ',st);slp:=Pos('/',st);
100 if (slp<spp)and(slp<>0) then
101 tmp:=Copy(st,slp+1,Length(st)-slp)
102 else
103 tmp:=Copy(st,spp+1,Length(st)-spp);
104 if tmp=st then FileParameters:='' else
105 FileParameters:=tmp;
106 end;
107 {$IFDEF MSDOS}
108 function FileNameComp(Filename,JokerFile:string):boolean;
109 var n:array[1..2] of namestr;
110 e:array[1..2] of extstr;
111 d:array[1..2] of dirstr;
112 a:byte;
113 begin
114 FSplit(Filename,d[1],n[1],e[1]);
115 FSplit(JokerFile,d[2],n[2],e[2]);
116 if Pos('*',n[2])>0 then n[2]:=Copy(n[2],1,Pred(Pos('*',n[2])))+'????????';
117 if Pos('*',e[2])>0 then e[2]:=Copy(e[2],1,Pred(Pos('*',e[2])))+'???';
118 if e[2]='' then e[2]:='.';
119 if (Length(n[1])>Length(n[2]))or
120 (Length(e[1])>Length(e[2])) then
121 begin
122 FilenameComp:=false;
123 Exit;
124 end;
125 a:=1;
126 while a<=Length(n[2]) do
127 begin
128 if (n[1][a]<>n[2][a])and(n[2][a]<>'?') then
129 begin
130 FilenameComp:=false;Exit;
131 end;
132 Inc(a);
133 end;
134 a:=1;
135 while a<=Length(e[2]) do
136 begin
137 if (e[1][a]<>e[2][a])and(e[2][a]<>'?') then
138 begin
139 FilenameComp:=false;Exit;
140 end;
141 Inc(a);
142 end;
143 FilenameComp:=true;
144 end;
145 {$ENDIF}
146 {$IFDEF WINDOWS}
147 function FileNameComp(Filename,JokerFile:string):boolean;
148 var n2:array[1..2] of array[1..9] of char;
149 e2:array[1..2] of array[1..9] of char;
150 d:array[1..2] of array[0..255] of char;
151 a:byte;
152 Fn,JF:array[0..255] of char;
153 n:array[1..2]of string[8];
154 e:array[1..2]of string[4];
155 begin
156 StrPCopy(@Fn,Filename);
157 StrPCopy(@JF,JokerFile);
158 FileSplit(@Fn,@d[1],@n2[1],@e2[1]);
159 FileSplit(@JF,@d[2],@n2[2],@e2[2]);
160 for a:=1 to 2 do
161 begin
162 n[a]:=StrPas(@n2[a]);
163 e[a]:=StrPas(@e2[a]);
164 end;
165 if Pos('*',n[2])>0 then n[2]:=Copy(n[2],1,Pred(Pos('*',n[2])))+'????????';
166 if Pos('*',e[2])>0 then e[2]:=Copy(e[2],1,Pred(Pos('*',e[2])))+'???';
167 if e[2]='' then e[2]:='.';
168 if (Length(n[1])>Length(n[2]))or
169 (Length(e[1])>Length(e[2])) then
170 begin
171 FilenameComp:=false;
172 Exit;
173 end;
174 a:=1;
175 while a<=Length(n[2]) do
176 begin
177 if (n[1][a]<>n[2][a])and(n[2][a]<>'?') then
178 begin
179 FilenameComp:=false;Exit;
180 end;
181 Inc(a);
182 end;
183 a:=1;
184 while a<=Length(e[2]) do
185 begin
186 if (e[1][a]<>e[2][a])and(e[2][a]<>'?') then
187 begin
188 FilenameComp:=false;Exit;
189 end;
190 Inc(a);
191 end;
192 FilenameComp:=true;
193 end;
194 {$ENDIF}
195 function UpStr(st:string):string;
196 var tmp:string;
197 a:byte;
198 begin
199 tmp:='';
200 for a:=1 to length(st) do
201 case st[a] of
202 '?':tmp:=tmp+'?';
203 '?':tmp:=tmp+'?';
204 '?':tmp:=tmp+'s';
205 else tmp:=tmp+Upcase(st[a]);end;
206 UpStr:=tmp;
207 end;
208 function Int2Hex(w:longint):string;
209 var tmp:string;
210 begin
211 tmp:='';
212 while w<>0 do
213 begin
214 tmp:=HexStr[Succ(w and 15)]+tmp;
215 w:=w shr 4;
216 end;
217 Int2Hex:=tmp;
218 end;
219 function Hex2Int(st:string):longint;
220 const hex='0123456789ABCDEF';
221 var n:longint;
222 begin
223 n:=0;
224 while st<>'' do
225 begin
226 n:=n*16+(Pos(UpCase(st[1]),hex)-1);
227 Delete(st,1,1);
228 end;
229 Hex2Int:=n;
230 end;
231 function Int2Bin(w:longint;bitcount:byte):string;
232 var s:string;
233 begin
234 s:='';
235 while bitcount>0 do
236 begin
237 if (w shr Pred(bitcount))and 1=0 then s:=s+'0'
238 else s:=s+'1';
239 dec(bitcount);
240 end;
241 Int2Bin:=s;
242 end;
243 {$IFDEF MSDOS}
244 function GetPathEnvironmentFile(Filename:string):string;
245 var Path,LilPath:string;
246 p:byte;
247 f:file;
248 begin
249 Path:=GetEnv('PATH');
250 while Path<>'' do
251 begin
252 p:=Pos(';',Path);
253 if p>0 then
254 begin
255 LilPath:=Copy(Path,1,Pred(P));
256 Delete(Path,1,P);
257 end else
258 begin
259 LilPath:=Path;
260 Path:='';
261 end;
262 if LilPath[Length(LilPath)]<>'\' then LilPath:=LilPath+'\';
263 Assign(f,LilPath+Filename);
264 {$I-}Reset(f);Close(f);{$I+}
265 if IOResult=0 then
266 begin
267 GetPathEnvironmentFile:=LilPath+Filename;
268 Exit;
269 end;
270 end;
271 GetPathEnvironmentFile:='';
272 end;
273 {$ENDIF}
274 end.
275