<% Response.Buffer = True Response.Expires = 0 Q = Request.QueryString("Q") Table = Request.QueryString("T") Set Conn = Server.CreateObject("ADODB.Connection") Conn.Open DB Set RS = Conn.Execute("SELECT * FROM " & Table & " WHERE ID=" & Q) Von = RS(1) Bis = RS(2) if IsNull(Bis) or Bis="" then Bis = Von Title = RS(3) Tex = RS(4) Ort = RS(5) ST = RS(6) ET = RS(7) if not IsDate(ST) then ST = CDate("00:00") if not IsDate(ET) then ET = ST Link = RS(9) RS.Close Set RS = Nothing Conn.Close Set Conn = Nothing TYear = Year(Von) TMonth = Month(Von) TDay = Day(Von) THour = Hour(ST) TMinute = Minute(ST) GMTVon = GetGMTTime(TYear,TMonth,TDay,THour,TMinute) GMTVon = Split(GMTVon,",") TYear = Year(Bis) TMonth = Month(Bis) TDay = Day(Bis) THour = Hour(ET) TMinute = Minute(ET) GMTBis = GetGMTTime(TYear,TMonth,TDay,THour,TMinute) GMTBis = Split(GMTBis,",") Response.Clear Response.contentType = "text/plain" response.write "BEGIN:VCALENDAR" & VBCRLF response.write "VERSION:1.0" & VBCRLF response.write "BEGIN:VEVENT" & VBCRLF response.write "DTSTART:" & GMTVon(0) & Lead(GMTVon(1)) & Lead(GMTVon(2)) & "T" & Lead(GMTVon(3)) & Lead(GMTVon(4)) & "00Z" & VBCRLF response.write "DTEND:" & GMTBis(0) & Lead(GMTBis(1)) & Lead(GMTBis(2)) & "T" & Lead(GMTBis(3)) & Lead(GMTBis(4)) & "00Z" & VBCRLF ' response.write "DCREATED:20000216T175006Z" & VBCRLF ' response.write "LAST_MODIFIED:20010216T175125Z" & VBCRLF response.write "STATUS:BUSY" & VBCRLF response.write "SUMMARY:" & Umlaute(Title) & VBCRLF if tex<>"" then response.write "DESCRIPTION: " & Umlaute(tex) & VBCRLF end if if Link<>"" then if Left(Link,3)="www" or Left(Link,4)="http" then response.write "URL:" & Link & VBCRLF end if response.write "LOCATION:" & Ort & VBCRLF response.write "END:VEVENT" & VBCRLF response.write "END:VCALENDAR" & VBCRLF Response.End Function Lead(s) if Len(s)=1 then s = "0" & s Lead = s End Function Function Strip(s) Dim pp,qq if VarType(s)=8 and s<>"" then pp=1 Do pp = Instr(pp,s,"<") if pp>0 then qq = Instr(pp+1,s,">") if qq>0 then s = Left(s,pp-1) & Mid(s,qq+1) else pp = pp+1 end if Loop until pp=0 end if Strip = s End Function Function Umlaute(tex) if tex<>"" then tex = Strip(tex) tex = Replace(tex,"ü","ue") tex = Replace(tex,"ä","ae") tex = Replace(tex,"ö","oe") tex = Replace(tex,"Ü","Ue") tex = Replace(tex,"Ä","Ae") tex = Replace(tex,"Ö","Oe") tex = Replace(tex,VBCrLf,"\n") tex = Replace(tex," "," ") end if Umlaute = tex End Function %>