2013-06-19 07:43

'*********************************************************************************
'DatabaseViewer 0.1
'ODBC.inc is a sample from rapidq-homepage.
'Christian Krumme 11-02 -> christiankrumme@yahoo.de
'This program can open Access and dBase Files and read the content.
'I don't know how to save data into files, i just found "PutData", but how to do?
'So, feel free to improve this code and send me a copy, please!!!
'*********************************************************************************

     $ESCAPECHARS ON
     $INCLUDE "Rapidq.inc"
     $INCLUDE "ODBC.inc"

'$Option ICON "d:\rapidq\aktuelle projekte\databaseviewer\icon.ico"

     DIM OpenDialog AS QOPENDIALOG
     OpenDialog.Filter = "Supported Files | *.mdb; *.dbf; *.mdx; *.ndx"

     DIM i AS INTEGER
     DIM j AS INTEGER

     DECLARE SUB Oeffnen_OnClick
     DECLARE SUB OutLine_OnClick
     DECLARE SUB Info_OnClick
     DECLARE SUB Ende_OnClick

     CREATE Form AS QFORM
      CAPTION = "DatabaseViewer"
      Width = Screen.Width
      Height = Screen.Height
      Center
      CREATE MainMenu AS QMAINMENU
       CREATE FileItem AS QMENUITEM
        CAPTION = "File"
        CREATE OpenItem AS QMENUITEM
         CAPTION = "Open"
         OnClick = Oeffnen_OnClick
        END CREATE
        CREATE SaveItem AS QMENUITEM
         CAPTION = "Save"
         Enabled = FALSE
        END CREATE
        CREATE SeparatorItem1 AS QMENUITEM
         CAPTION = "-"
        END CREATE
        CREATE ExitItem AS QMENUITEM
         CAPTION = "Exit"
         OnClick = Ende_OnClick
        END CREATE
       END CREATE
       CREATE InfoItem AS QMENUITEM
        CAPTION = "Info"
        CREATE AboutItem AS QMENUITEM
         CAPTION = "About"
         OnClick = Info_OnClick
        END CREATE
       END CREATE
      END CREATE
      CREATE Label1 AS QLABEL
       CAPTION = "Tables in File:"
       Left = 8
       Top = 8
       Width = 80
       Transparent = 1
      END CREATE
      CREATE Label2 AS QLABEL
       CAPTION = "Content:"
       Left = 152
       Top = 8
       Width = 48
       Transparent = 1
      END CREATE
      CREATE Outline AS QOUTLINE
       OutLineStyle = 2
       Top = 24
       Left = 8
       Height = Screen.Height - Screen.Height / 7.4
       Width = 133
       'Color = 15658734
       ItemHeight = 15
       'OnDblClick = OutLineClick
       OnClick = Outline_OnClick
       AddOptions = 0
       Cursor = crHandPoint
      END CREATE
      CREATE StringGrid1 AS QSTRINGGRID
       Left = 152
       Top = 24
       Height = OutLine.Height
       Width = Screen.Width - Screen.Width / 6.1
       Col = 0
       DefaultColWidth = 78
       FixedCols = 0
       RowCount = 0
       DefaultRowHeight = 17
       AddOptions(goEditing)
      END CREATE
     END CREATE

     DECLARE FUNCTION setwindowlong LIB "user32" ALIAS "SetWindowLongA"(hWnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG
     SUB MinSet(fHand AS INTEGER, gwl_hand AS INTEGER, hwnd AS INTEGER, apphand AS INTEGER)
      SetWindowLong(Fhand, Gwl_Hand, Hwnd)
      SetWindowLong(apphand, GWL_Hand, fhand)
     END SUB
     Minset(Form.Handle, -8, 0, application.Handle)

     Form.SHOWMODAL

'nach Programmende Datenbank loesen
'release database
     myDB.CloseDB
     myDB.CloseODBC


'**** Oeffnen *****************************************************************************

     SUB Oeffnen_OnClick

'Alte Daten in der Tabelle loeschen
'Delete old data into StringGrid
      Outline.Clear

      FOR i = 1 TO StringGrid1.ColCount - 1
       StringGrid1.DeleteCol(i)
      NEXT i

      FOR i = 1 TO StringGrid1.RowCount - 1
       StringGrid1.DeleteRow(i)
      NEXT i


'Alte Datenbank schliessen
'Close old DataBase
      myDB.CloseQuery
      myDB.CloseDB

'neue Datenbank auswaehlen
'Connect to new database
      IF OpenDialog.EXECUTE THEN

       IF RIGHT$(OpenDialog.FileName, 3) = "mdb" THEN
        sCon$ = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" + OpenDialog.FileName + ";PWD=; UID=admin;"
       END IF

       IF RIGHT$(OpenDialog.FileName, 3) = "dbf" THEN
        sCon$ = "DRIVER={Microsoft dBase Driver (*.dbf)};DBQ=" + OpenDialog.FileName + ";PWD=; UID=admin;"
       END IF

       IF RIGHT$(OpenDialog.FileName, 3) = "ndx" THEN
        sCon$ = "DRIVER={Microsoft dBase Driver (*.dbf)};DBQ=" + OpenDialog.FileName + ";PWD=; UID=admin;"
       END IF

       IF RIGHT$(OpenDialog.FileName, 3) = "mdx" THEN
        sCon$ = "DRIVER={Microsoft dBase Driver (*.dbf)};DBQ=" + OpenDialog.FileName + ";PWD=; UID=admin;"
       END IF

       myDB.Connect(sCon$)

       FOR i = 1 TO myDB.TableCount
        Outline.AddLines(MyDB.Table(i))
       NEXT i

      END IF

      MyDB.CloseQuery

     END SUB

'**** Tabelle waehlen / choose table *****************************************************************

     SUB Outline_OnClick

      Outline.Cursor = crHourGlass
      StringGrid1.Cursor = crHourGlass

'alte daten loeschen
'delete old data into StringGrid
      FOR i = 1 TO StringGrid1.ColCount - 1
       StringGrid1.DeleteCol(i)
      NEXT i

      FOR i = 1 TO StringGrid1.RowCount - 1
       StringGrid1.DeleteRow(i)
      NEXT i


'Columns laden
'load columns into StringGrid
      q$="select * from " + MyDB.Table(OutLine.ItemIndex)
      myDB.Query(q$)

      FOR i = 1 TO myDB.FieldCount
       StringGrid1.InsertCol(i)
       StringGrid1.Cell((i - 1), 0) = myDB.Field.Name(i)
      NEXT i

'Rows laden
'load rows, put data into StringGrid.Row(x)
      j = 0
      WHILE myDB.GetRecord = 1
       j = j + 1
       StringGrid1.InsertRow(j)
       FOR i = 1 TO MyDB.FieldCount
        StringGrid1.Cell(i-1, j) = myDB.Field.DATA(i)
       NEXT
      WEND

      OutLine.Cursor = crArrow
      StringGrid1.Cursor = crArrow


      myDB.CloseQuery


     END SUB

'**** info ********************************************************************************
     SUB Info_OnClick
      SHOWMESSAGE "DatabaseViewer\n\nChristian Krumme '02\nchristiankrumme@yahoo.de"
     END SUB

'**** Ende ********************************************************************************
     SUB Ende_OnClick
      Form.CLOSE
     END SUB

2013-06-19 07:43