TRANSFORMER UN CHAMPS BINAIRE EN JPG A PARTIR D'UN CHAMP IMAGE SOUS SQL (VBS)

DIM ServeurSql
DIM BD
DIM TABLE
DIM PK
DIM ValeurPK
DIM Picture
DIM StringSql


ServeurSql = InputBox("Entrez le nom du Serveur Sql","Serveur Sql")
BD         = InputBox("Entrez le nom de la BD Sql","Serveur Sql")
TABLE      = InputBox("Entrez le nom de la table Sql","Serveur Sql")
Picture    = InputBox("Entrez le nom du champ ou ce trouve la photo","Serveur Sql")
PK         = InputBox("Entrez le nom du champ PK (Unique)","Serveur Sql")
ValeurPK   = InputBox("Entrez la valeur du PK (Unique)","Serveur Sql")

 

'***********************CONSTRUCTION DE L'INSTRUTION SQL************
StringSql = "Select " + Picture  + " FROM " + BD + ".." + TABLE + " WHERE " + PK + "=" + ValeurPK

'***********************DECLARATION DES CONSTANTES******************

Const PathSauvegarde = "c:\temp.jpg"

'***********************DECLARATION DES VARIABLES********************
DIM ADO
DIM RS
DIM Photo
DIM Path
DIM ChaineConnexion 
DIM Heure
DIM Compteur

ChaineConnexion= "Integrated Security=SSPI;Provider=SQLOLEDB;data Source=" & ServeurSql & ";Initial Catalog=" + BD + ";"

'*************************DEBUT DU PROGRAMME*************************
Compteur = 0
Heure = Now

Set ADO = CreateObject("ADODB.Connection")
ADO.ConnectionString = ChaineConnexion
ADO.open
msgbox stringsql
set rs = ADO.Execute(StringSQL)

Photo = RS(picture)
SavePictureToDisk PathSauvegarde ,Photo
rs.movenext
Compteur = Compteur + 1


Ado.Close
Set Ado = Nothing
Set Rs = Nothing

MsgBox Compteur & " enregistrements sauvegardés dans le repertoire " & PathSauvegarde & vbNewLine & _ 
      "Vous avez debuté le traitement a " & Heure & vbNewLine & _
      "Il est présentement " & Now

'***********************FIN PROGRAMME *********************************


'****************  FONCTION SAVE PICTURE TO DISK **********************
Function SavePictureToDisk(Path,Photo)

  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  'Creation de l'object Stream 
  Dim BinaryStream
  Set BinaryStream = CreateObject("ADODB.Stream")
  
  'Specify stream type 
  BinaryStream.Type = adTypeBinary
  
  'Ouvrir Stream et ecrire binaire dans l'objet
  BinaryStream.Open
  BinaryStream.Write Photo
  
  'Save binary data To disk
  BinaryStream.SaveToFile Path, adSaveCreateOverWrite
End Function