Transformer un champs binaire en jpg a partir d'un champ image sous sql (vbs)

Télécharger le projet
Commenter

Description

Voici un petit bout de code en VBS qui permet une connection a une BD SQL qui extrait un champs binaire et le transforme en jpg sur le disque de la machine qui execute le code.

Source / Exemple : 


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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Myke)