PureBasic

Code : Tout sélectionner

File$ = "C:\bd1.mdb" 
#ODBC_ADD_DSN = 1 ; Add Data source 
#ODBC_CONFIG_DSN = 2 ; Configure (edit) Data source 
#ODBC_REMOVE_DSN = 3 ; Remove Data source 



;- Fct - Connexion à la BD
Procedure MakeConnection(Driver.s,strAttributes.s) 
  Result=OpenLibrary(1,"ODBCCP32.DLL") 
  If Result 
    lpszDriver.s=Driver 
    MyMemory=AllocateMemory(Len(strAttributes)) 
    CopyMemory(@strAttributes,MyMemory,Len(strAttributes)) 
    For L=1 To Len(strAttributes ) 
      If PeekB(MyMemory +l-1)=Asc(";"):PokeB(MyMemory +l-1,0):  EndIf 
    Next L 
    Result = CallFunction(1, "SQLConfigDataSource", 0,#ODBC_ADD_DSN,lpszDriver.s,MyMemory ) 
    NewResult=SQLConfigDataSource_(0,#ODBC_ADD_DSN,lpszDriver.s,MyMemory ) 
    
    FreeMemory(1) 
    CloseLibrary(1) 
    If Result 
      ProcedureReturn 1 
    EndIf 
  EndIf 
EndProcedure 


;- Fct - Fermeture de laconnexion
Procedure DeleteConnection(Driver.s,DSN.s) 
  Result=OpenLibrary(1,"ODBCCP32.DLL") 
  If Result 
    lpszDriver.s=Driver 
    strAttributes.s = "DSN="+DSN 
    Result = CallFunction(1, "SQLConfigDataSource", 0,#ODBC_REMOVE_DSN,lpszDriver.s,strAttributes ) 
    CloseLibrary(1) 
    If Result 
      ProcedureReturn 1;MessageRequester("Info","DSN Delete",0) 
    EndIf 
  EndIf 
EndProcedure 


MeinPointer.l 
Procedure GetDBHandle() 
  Shared MeinPointer.l 
  !EXTRN _PB_DataBase_CurrentObject;_PB_DataBase_CurrentObject 
  !MOV dword EAX,[_PB_DataBase_CurrentObject] 
  !MOV dword [v_MeinPointer], EAX 
  ProcedureReturn MeinPointer 
EndProcedure 


If File$ ="" : End : EndIf 


;- On regarde l extension pour avoir la ligne de commande
EXT.s=UCase(GetExtensionPart(File$)) 
Select EXT 
Case "MDB" 
  Result=Makeconnection("Microsoft Access Driver (*.mdb)","Server=SomeServer; Description=Description For Purebasic MDB-ODBC;DSN=PureBasic_DSN;DBQ="+file$+";UID=Rings;PWD=Siggi;") 
Case "XLS" 
  Result=Makeconnection("Microsoft Excel Driver (*.xls)","DSN=PureBasic_DSN;Description=Description For Purebasic Excel;FileType=Excel97;DBQ="+File$+";") 
EndSelect 


;- Initialisation des fct de BD
If InitDatabase() = 0 
  MessageRequester("Error", "Can't initialize Database (ODBC v3 or better) environment", 0) 
  End 
EndIf 

OpenConsole() 

Dim DatabaseType.s(4) 
DatabaseType(0) = "Unknown" 
DatabaseType(1) = "Numeric" 
DatabaseType(2) = "String" 
DatabaseType(3) = "Float" 


; Open an ODBC database 
User$="" 
Password$="" 
#Database=1 


If OpenDatabase(#Database, "PureBasic_DSN", User$, Password$) 
 
  PrintN("") 
  PrintN("Database successfully opened !") 
  
  
  PrintN("Type EXIT to quit.") 
  PrintN("or anything else to browse database") 
  
  Repeat 
    Command$ = Input() 
    Select UCase(Command$) 
    Case "EXIT" 
      Quit = 1 
      
      Default 
      
      If DatabaseQuery(Command$) 
        
        NbColumns = DatabaseColumns() 
        PrintN("NbColums: " + Str(NbColumns)) 
        
        For k=0 To NbColumns-1 
          PrintN(DatabaseColumnName(k) + " - " + DatabaseType(DatabaseColumnType(k))) 
        Next 
        
        PrintN("") 
        Print ("Press return to continue") : Input() 
        PrintN("") 
        PrintN("Query Result -------------------------------------") 
        
        While NextDatabaseRow()
          For k=0 To NbColumns-2
          Print(GetDatabaseString(k) + " - ")
        Next

        PrintN(GetDatabaseString(NbColumns-1))
        
        PrintN("--------------------------------------------------") 
      Else 
        PrintN("Bad Query !") 
      EndIf 
    EndSelect 
  Until Quit = 1 
Else 
  MessageRequester("Info", "Operation canceled", 0) 
EndIf 

;- Deconnexion à la BD
DeleteConnection("Microsoft Access Driver (*.mdb)","PureBasic_DSN")