[es] - Upis fajlova sa diska u MS SQL Image polja

Zidar
Canada

Član broj: 15387
Poruke: 3085
*.eqao.com.

+79 Profil

Upis fajlova sa diska u MS SQL Image polja

^{22.12.2005. u 13:50 - pre 223 meseci}

Imam 1500 PDF fajlova na disku (na primer 5102200083777777095661.pdf). Fajlovi treba da se prebace u SQL bazu (ne pitajte zasto, znam da je efikasnije da se cuva samo path i da se citaju fajlovi sa diska itd, ali mora ovako)

Imam tabelu PDFFiles, na MS SQL serveru, sa poljima

BarCode, varchar(22)
PDFfile, image

Treba mi VBA (ADO?) funkcija ili procedura koja ce da uzme filename i path kao ulazni parametar i da taj file upise kao novi rekord u tabelu. Nesto kao:

Sub UpisiImage(strFilePath as string)
..
End Sub

koju bih pozivao iz VBA ovako:

Call UpisiImage("C:\Temp\5102200083777777095661.pdf")

Rezultat ovog poziva treba da bude novi rekord u tabeli PDFFiles, gde u polju BarCode pise '5102200083777777095661' a u Image polju PDFfile se nalazi fajl 5102200083777777095661.pdf

Ne treba mi procedura za citanje iz image file, to imam, radi nesto sa Ado.GetChunk.

Moze li neko da pomogne?

Odgovor na temu

goranvuc
Goran Vucicevic
Novi Sad

Član broj: 4934
Poruke: 1846
*.dialup.neobee.net.

+41 Profil

Re: Upis fajlova sa diska u MS SQL Image polja

^{22.12.2005. u 14:06 - pre 223 meseci}

Evo ti nesto sto sam ja koristio:

Code:

Public Sub UpisiSlikuUBazu(ByVal NAZIV_TABELE As String, _
                                    ByVal NAZIV_POLJA As String, _
                                    ByVal ID As String, _
                                    ByVal ID_Vrednost As Long, _
                                    ByVal PUTANJA As String)


   Dim rstTEMP As New ADODB.Recordset

   Dim bytePodatak() As Byte
   Dim lngBrojac As Long
   Dim intBroj_Datoteke As Integer

   Dim lngDuzina_Datoteke As Long
   Dim lngBroj_Blokova As Integer
   Dim lngOstatak As Long

   Const Velicina_Bloka = 100

   On Error GoTo GRESKA_UPITA
   rstTEMP.Open "SELECT " & ID & ", " & NAZIV_POLJA & " " & _
                "FROM " & NAZIV_TABELE & " " & _
                "WHERE " & ID & " = " & ID_Vrednost, _
                KONEKCIJA, adOpenStatic, adLockOptimistic, adCmdText
   On Error GoTo 0

   If rstTEMP.EOF Or rstTEMP.BOF Then
      rstTEMP.Close
      Set rstTEMP = Nothing
      'MsgBox "NE POSTOJI TRAZENI SLOG"
      Exit Sub
   End If

   If rstTEMP(NAZIV_POLJA).Type <> adLongVarBinary Then
      rstTEMP.Close
      Set rstTEMP = Nothing
      'MsgBox "POLJE NIJE ODGOVARAJUCEG TIPA"
      Exit Sub
   End If

   'Otvaranje datoteke i odredjivanje velicine
   intBroj_Datoteke = FreeFile
   Open PUTANJA For Binary Access Read As intBroj_Datoteke
   lngDuzina_Datoteke = LOF(intBroj_Datoteke)

   If lngDuzina_Datoteke = 0 Then
      rstTEMP.Close
      Set rstTEMP = Nothing
      Close intBroj_Datoteke
      Exit Sub
   End If

   lngBroj_Blokova = lngDuzina_Datoteke \ Velicina_Bloka
   lngOstatak = lngDuzina_Datoteke Mod Velicina_Bloka

   'Ucitavanje null vrednosti
   rstTEMP(NAZIV_POLJA).AppendChunk Null

   'Ucitavanje ostatka u polje
   ReDim bytePodatak(lngOstatak)
   Get intBroj_Datoteke, , bytePodatak()
   rstTEMP(NAZIV_POLJA).AppendChunk bytePodatak()

   'Ucitavanje svega ostalog
   ReDim bytePodatak(Velicina_Bloka)
   For lngBrojac = 1 To lngBroj_Blokova
      Get intBroj_Datoteke, , bytePodatak()
      rstTEMP(NAZIV_POLJA).AppendChunk bytePodatak()
   Next

   rstTEMP.Update
   rstTEMP.Close
   Set rstTEMP = Nothing
   Close intBroj_Datoteke

   Exit Sub

GRESKA_UPITA:
   'MsgBox "NEISPRAVAN UPIT"
   Set rstTEMP = Nothing

End Sub

Ako se dobro secam, podrazumevalo se da prethodno vec imas informaciju o kljucu sloga - tj. da on postoji u bazi. Ako upisujes u novododat slog, prvo ga snimi bez upisanog BLOB-a, pa onda pozovi funkciju. Inace, promenljiva KONEKCIJA je referenca na otvorenu konekciju u programu.
Srecno, i izvini na citljivosti koda, preuzeo sam ga iz starih projekata - sada bih ga drugacije napisao.

Odgovor na temu