ADO-Upload

[Seidl]

@ _m3:

Ich kann einfach die Spannung nicht länger ertragen
Hast du mit deinem Versuch noch irgendwas zu Tage gebracht?

Falls du's noch nicht probiert hast, hier als kleiner Anreiz das Notes-Script mit dem einen Upload auf einen Windows-Server bei ActiveISP erfolgreich getestet habe:

----------------------------------------------------------------
Beispielaufruf:
UploadFile"c:\anything.jpg", "URL=http://www.anywhere.at/anything.jpg", "Username", "Password", False
UploadFile"c:\anything.htm", "URL=http://www.anywhere.at/anything.htm", "Username", "Password", True
----------------------------------------------------------------
Option Public
Option Declare
%INCLUDE "lsconst.lss"


Const adModeReadWrite = 3
Const adCreateNonCollection = 0
Const adCreateOverwrite = 67108864
Const adDelayFetchStream = 16384
Const adOpenStreamFromRecord = 4
Const adTypeText = 2
Const adTypeBinary = 1


Public Function UploadFile(strSource As String, strTarget As String, Username As String, Password As String, ASCII As Integer) As Integer
' Funktion
' Die Datei unter dem Pfad 'strSource' wird unter der URL 'strTarget' gespeichert. Sollte unter strTarget bereits
' eine Datei vorhanden sein, so wird diese ohne Rückfrage überschrieben!
' IN
' strSource Pfad und Dateiname für die Quelldatei
' strTarget URL unter der die Datei gespeichert werden soll
' Username Benutzername für Zugriff auf das Zielverzeichnis
' Password Passendes Passwort zum Benutzernamen
' ASCII Wenn TRUE wird die Datei als ASCII-Text übertragen. Sonst binär.
On Error Goto Hell
Dim recTarget As Variant
Dim stmTarget As Variant
Dim ErrorCount As Integer
UploadFile = False
ErrorCount = 0
Set recTarget = CreateObject("ADODB.Record.2.7")
Set stmTarget = CreateObject("ADODB.Stream.2.7")
TryToOpen:
recTarget.Open "", strTarget, adModeReadWrite, adCreateNonCollection Or adCreateOverwrite, adDelayFetchStream, Username, Password
stmTarget.Open recTarget, adModeReadWrite, adOpenStreamFromRecord
If ASCII Then
stmTarget.Charset = "ascii"
stmTarget.Type = adTypeText
Else
stmTarget.Type = adTypeBinary
End If
stmTarget.LoadFromFile strSource
Call recTarget.Close()
stmTarget.Close
Set recTarget = Nothing
Set stmTarget = Nothing
UploadFile = True
Exit Function
Hell:
ErrorCount = ErrorCount + 1
Sleep(1)
If ErrorCount < 30 Then
Resume TryToOpen
Elseif Err = 213 Then
Msgbox "Der Upload der Datei '" & strSource & "'" & Chr(13) & "nach '" & Right(strTarget, Len(strTarget)-11) & "'" & Chr(13) & "konnte nicht abgeschlossen werden.", MB_ICONEXCLAMATION, "ADO-Fehler"
Resume GiveUp
Else
Msgbox Error(Err), MB_ICONEXCLAMATION, "ADO-Fehler " & Cstr(Err)
End If
GiveUp:
End Function
--------------------------------------------------------------

PS: Ich muss zugeben, dass ich mich seit meinem letzten Posting nicht mehr auf der MS-Homepage herumgetrieben habe. Ich wollte erst mal abwarten was dein Test ergibt. Heute bin ich dann zufällig wieder über das Script gestolpert und habe mal nach dem Thread gesehen.
Das Script ist übrigens natürlich weit davon entfernt perfekt zu sein. Es ist eben nur mal ein prinzipieller Versuch wie man die Sache bewerkstelligen könnte.