<doku>
<about>Ein String 's' wird mittels Trenner 'trenner' in Teilstücke zerlegt.
Die Teile werden im Array 'ergebnis' abgelegt.
Der Rückgabewert ist die Anzahl der Teilstücke.
Beispiel:
<code>
var erg : String[]
var anz : integer = splitstring('ein/geteilter/string','/',erg)
</code>
</about>
</doku>
==========================================================================
Procedure splitstring(s : String; trenner : String; Var ergebnis : String[]):integer
==========================================================================
Var anz , a1: Integer = Scan(trenner,s)+1
Var posi : Integer
Var i : Integer = -1
InitArray(ergebnis[anz])
While anz-->=0 Do
posi := Pos(trenner,s)
ergebnis[i++] := s[1,posi-1]
s:=s[posi+1,255]
End
return a1ENDPROC
<doku>
<about>Selektionsergebnis in eine XML-Datei schieben zur weiteren Verarbeitung mit XSLT o.ä.
datname: Datenbankname
suche: Selektion
sortierung: name der Indexdatei zum Sortieren
datout: XML-Ausgabedatei
</about>
</doku>
===========================================================
procedure dbtoxml(datname, suche,sortierung, datout : string)
===========================================================
var i : integer:=0
var db : integer = dbopen(datname)
var out : integer = REWRITE(datout,0)
var f : string
var j : string[]
PRIMTABLE(db)
access(db,sortierung)
writeln(out,'<data>')
sub _DBNAME(db)+', '+suche
i:=0
writeln(out,'<row>')
while i++<=maxlabel(db) do
splitstring(getstructure(db,i),',',j)
write(out,'<'+LABEL(db,i)+' t="'+j[1]+'"')
if HIGH(1,j)>1 then
write(out,' l="'+j[2]+'"')
end
if HIGH(1,j)>2 then
write(out,' nk="'+j[3]+'"')
end
write(out,' >')
f := (getfield(db,i))
if getstructure(db,i) like '*NUMBER*' then
f:= exchange(f,'.',',')
end
f:=exchange(f,'&','+')
f:=exchange(f,'<','<')
f:=exchange(f,'>','>')
write(out,(f))
write(out,'</'+ LABEL(db,i)+'>')
end
writeln(out,'</row>')
endsub
writeln(out,'</data>')
CLOSEDB(db)
CLOSE(out)
endproc
Wandelt eine ANSI-Datei in einen HEX-Code um.
'source' und 'dest' bezeichnen Dateinamen.
=====================================================
procedure encodehex(source : string;dest : string)
=====================================================
var hex : string = "0123456789ABCDEF"
var bh,bl : integer
var b : string
var d : integer = reset(source,1);
var d1 : integer = rewrite(dest,0);
While not eot(d) do
b:=read(d,1)
bh := asc(b) div 16
bl := asc(b) mod 16
Write(d1,hex[bh+1])
Write(d1,hex[bl+1])
Endclose(d1)
close(d)
endproc
Wandelt eine in HEX codierte Datei wieder in ihre ursprüngliche Form
'source' und 'dest' bezeichnen Dateinamen
=====================================================
procedure decodehex(source : string;dest : string)
=====================================================
var hex : string = "0123456789ABCDEF"
var bh,bl : string
var b : integer
var d : integer = reset(source,0);
var d1 : integer = rewrite(dest,1);
While not eot(d) do
bh:=read(d,1)
bl:=read(d,1)
b := (POS(upper(bh),hex) - 1)*16+(POS(upper(bl),hex) - 1)
Write(d1,chr(b))
Endclose(d1)
close(d)
endproc
Prüft, ob ein String eine gültige Zahl darstellt.
procedure isNumber(s:string):integer
/*
Prüft ob es sich bei s um eine gültige Zahl handelt
*/
var p : integer = 0
var b : integer = 1
var m : integer = Length(s)
var c : string = "0123456789."
while p++<=m,b:=Pos(s[p],c) do end
return b
endproc
Legt einen Verzeichnisbaum (z.B. rMakeDir("/var/tdbengine/temp/data/"))an
procedure rMakeDir(sPath:STRING)
/*
Rekursives MakeDir
Legt einen ganzen Verzeichnisbaum an, wenn er nicht bereits existiert
*/
var sPre : STRING
var sPart : STRING
var p : INTEGER
if !IsFile(sPath) then
if RightStr(sPath,1)#"/" then
sPath := sPath +"/"
end
p:=Pos("/",sPath)
if sPath[1,p] = "../" or sPath[1,p] = "./" or sPath[1,p] = "/" then
sPre := sPath[1,p]
sPath := sPath[p+1,255]
end
while p:=Pos("/",sPath) do
sPart := sPath[1,p]
MakeDir(sPre+sPart)
sPre := sPre + sPart
sPath := sPath[p+1,255]
end
end
endproc
Generiert einen RFC822-konformen Datumsstring aus einer UNIX_TIMESTAMP. Ideal für Cookie-Expiration-Angaben.
procedure rfcDateStr(iSeconds : INTEGER) : string
/*
Generiert einen Datumsstring, wie in RFC 822 definiert, jedoch ohne Zeitzonen-Angabe am Ende
Sunday, 01-Dec-2099 12:00:00
*/
var s : STRING
Var sD, sM : STRING
var iD : INTEGER
iD := UNIX_Date(iSeconds)
s := Choice( 1+(iD+5) MOD 7,"Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")+", "
s := s + Str(Day(iD),2,0,"","0") +"-"
s := s + Choice(Month(iD)+1,"Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec") + "-"
s := s + Str(Year(iD)) +" "+TimeStr(UNIX_Time(iSeconds),0)
return s
endproc
library:index, Rev. 18, Zuletzt geändert 2005-06-08 10:34, 1156 Aufrufe