Script Library: paradox-protocol.r

Script Library: 1247 scripts
paradox-protocol.r

REBOL [
    Title: "PARADOX-PROTOCOL"
    File: %paradox-protocol.r
    Author: "nicolas"
    Purpose: "Paradox database REBOL protocol"
    Email: "nverscheure free fr"
  Library: [ 
    level: 'beginner 
    platform: 'all 
    type: [protocol] 
    domain: [database] 
    tested-under: [windows] 
    support: none 
  ] 
    Description: {
        Paradox Database REBOL protocol
        Based on the work of Randy Beck
        %rb--randybeck--com
        http://www.randybeck.com
        Paradox file format description :
        http://www.scalabium.com/pdx/pdx2txt.htm
        
        Datatype supported : char, longint, logical, date, time
        
        Do not support index file and other stuff Like that.
        Very basic approach.
        
        For the writting of the protocol, get inspired by mysql protocol 
        written by DocKimbel Softinnov (http://softinnov.org)
        
        ROADMAP :
        - Correct port : distinct directory from single file
        - Test protocol with heavy file
        - Make a paradox viewer with View
        - Implement SQL Command : SELECT
    }
    Version: 0.3.3
    Date: 03/03/2011
    History: [
        03/03/2011 0.3.3 "(nve) Correct problem with empty file and pb with directory"
        28/01/2011 0.3.2 "(nve) Release on rebol.org"
        16/11/2010 0.3.1 "(nve) Correct open for single file"
        13/11/2010 0.3.0 "(nve) Merge db-reader.r into protocol"
        05/11/2010 0.2.0 "(nve) Send all the rows"
        03/11/2010 0.2.0 "(nve) Implement copy and insert function"
        02/11/2010 0.1.0 "(nve) Creation of the REBOL program"
    ]
    Comment: ""
    Usage: {
        >> do %paradox-protocol.r
        >> db-port: open paradox://MON_FICHIER_PARADOX.db
        >> insert db-port "SELECT * FROM MON_FICHIER_PARADOX"
        >> foreach item copy db-port [probe item]
        >> foreach item copy/part db-port 8 [probe item]
        >> close db-port
    }
    Notes: "Sorry for my english"
    License: {
        Copyright 2011 Nicolas Verscheure. All rights reserved.

        Redistribution and use in source and binary forms, with or without modification, are
        permitted provided that the following conditions are met:

           1. Redistributions of source code must retain the above copyright notice, this list of
              conditions and the following disclaimer.

           2. Redistributions in binary form must reproduce the above copyright notice, this list
              of conditions and the following disclaimer in the documentation and/or other materials
              provided with the distribution.

        THIS SOFTWARE IS PROVIDED BY NICOLAS VERSCHEURE ``AS IS'' AND ANY EXPRESS OR IMPLIED
        WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
        FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL NICOLAS VERSCHEURE OR
        CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
        CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
        SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
        ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
        NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
        ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

        The views and conclusions contained in the software and documentation are those of the
        authors and should not be interpreted as representing official policies, either expressed
        or implied, of Nicolas Verscheure.
    }
    Copyright: (c) 2011, Nicolas VERSCHEURE
]

make root-protocol [
    scheme: 'paradox
    db: object!
    port-flags: system/standard/port-flags/pass-thru    
    open*: get in system/words 'open
    copy*: get in system/words 'copy
    pick*: get in system/words 'pick
    close*: get in system/words 'close
    locals-class: make object! [
        stream-end?: none
        rowcount: 0
        columns: 0
        rownum: 0
    ]
    ;-----------------------------------------------------------------------------
    read-rows: func [port [port!] /part n [integer!]
        /local rows count
    ][
        either part [count: any [n 0]] [count: max any [n 0] port/locals/rowcount]
        rows: make block! max any [n 0] port/locals/rowcount
        for i 1 count 1 [
            port/locals/rownum: port/locals/rownum + 1
            if port/locals/stream-end?: (port/locals/rownum > port/locals/rowcount) [break]
            append/only rows pick* db/db-data port/locals/rownum
        ]
        rows
    ]
    ;------------------- DATABASE PARADOX ----------------------------------------
    db-database: make object! [
      empty-file: false
        db-file: file!
        db-type: [
            byte            1
            integer     2
            word            2
            longint     4
            shortint    2
            char            1
            pchar           4
            ^pchar      4
            date            4
            logical     1
            time            4
            timestamp   8
            number      8
        ]
        numRecords: none
        numFields: none
        db-structure: [
            #04     fileType        byte
            #05     maxTableSize    byte
            #06     numRecords      longint
            #21     numFields       integer
            #39     fileVersionID   byte
        ]
        maxTableSizeValue: [
            1   ["64M    (block size = $0400 bytes)" 1024   #0400]
            2   ["128M    (block size = $0800 bytes)" 2048  #0800]
            3   ["192M    (block size = $0C00 bytes)" 3072  #0C00]
            4   ["256M    (block size = $1000 bytes)" 4096  #1000]
        ]
        fileTypeValue: [
            0   "this is an indexed .DB data file"
            1   "this is a primary index .PX file"
            2   "this is a non-indexed .DB data file"
            3   "this is a non-incrementing secondary index .Xnn file"
            4   "this is a secondary index .Ynn file (inc or non-inc)"
            5   "this is an incrementing secondary index .Xnn file"
            6   "this is a non-incrementing secondary index .XGn file"
            7   "this is a secondary index .YGn file (inc or non inc)"
            8   "this is an incrementing secondary index .XGn file" 
        ]
        fileVersionIDValue: [
            3   [#03    "version 3.0"   79]
            4   [#04    "version 3.5"   79]
            5   [#05    "version 4.x"   79]
            6   [#06    "version 4.x"   79]
            7   [#07    "version 4.x"   79]
            8   [#08    "version 4.x"   79]
            9       [#09    "version 4.x"   79]
            10  [#0A    "version 5.x"   79]
            11  [#0B    "version 5.x"   79]
            12  [#0C    "version 7.x"   261]
        ]
        fieldTypeValue: [
            1   [char "Alpha" ]
            2   [date "Date" ]
            3       [shortint "Short integer" ]
            4       [longint "Long integer" ]
            5       [currency "currency" ]
            6       [number "Number" ]
            9       [logical "Logical" ]
            11  [byte "Memo BLOb" ]
            12  [byte "Binary Large Object" ]
            13  [byte "Formatted Memo BLOb" ]
            14  [byte "OLE" ]
            16  [byte "Graphic BLOb" ]
            20  [time "Time" ]
            21  [timestamp "Timestamp" ]
            22  [integer "Autoincrement" ]
            23  [byte "BCD" ]
            24  [byte "Bytes" ]
        ]
        db-data: []
        db-fieldtypes: []
        db-file-port: port! 
        ;===============================================================================
        ; READ STRUCTURE OF PARADOX FILE
        get-header: func [] [
            db-file-port: open*/seek db-file
            forskip db-structure 3 [
                d: copy*/part at db-file-port (to-integer db-structure/1) + 1 select db-type db-structure/3
                switch db-structure/2 [
                    fileType [
                        d: to-integer d
                    ]
                    maxTableSize [
                        d: (to-integer d) - (to-integer #F)
                    ]
                    numRecords [
                        d: to-integer reverse d
                    ]
                    numFields [
                        d: to-integer reverse d
                    ]
                ]
                set db-structure/2 d
            ]
            db-fieldtypes: []
            ; RECUPERATION DU TYPE DES CHAMPS 
            o: to-integer #79
            for n 1 numFields 1 [
                append db-fieldtypes to-integer copy*/part at db-file-port o 1
                o: o + 1
                append db-fieldtypes to-integer copy*/part at db-file-port o 1
                o: o + 1
            ] 
            ; NOM DE TABLE
            ; tableNamePtr
            o: o + 4
            ; array[1..(numFields)] of pchar         fieldNamePtrArray
            for n 1 numFields 1 [
                o: o + 4
            ]
            d: copy*/part at db-file-port o third select fileVersionIDValue to-integer fileVersionID
            t: copy* ""
            foreach i d [either i == 0 [break] [t: join t to-char i]]
            tableName: t
            ; RECUPERATION DU NOM DES CHAMPS 
            db-fieldnames: []
            o: to-integer #01C4
            for n 1 numFields 1 [
                s: copy* ""
                forever [
                    d: to-integer copy*/part at db-file-port o 1
                    o: o + 1
                    either d == 0 [
                        append db-fieldnames copy* s
                        break
                    ][
                        s: join s to-char d
                    ]
                ] 
            ]
            close* db-file-port
        ]
        ; RECUPERATION DES DONNEES
        get-data: func [] [ 
            db-data: []
            db-file-port: open*/seek db-file
            ; Start of 
            o: to-integer #0800
            ; 0002 | word      blockNumber
            o: o + 2
            blockNumber: to-integer copy*/part at db-file-port o 2
            ; 0004 | integer   addDataSize
            o: o + 2    
            addDataSize: to-integer copy*/part at db-file-port o 2
            ; 0006.......      fileData 
            o: o + 2 + 1
            for m 1 numRecords 1 [
                data-blk: copy* []
                for n 1 numFields 1 [
                    ; length of the datatype 
                    len: pick* db-fieldtypes (n * 2)
                    ; get data according to datatype
                    switch/default first select fieldTypeValue pick* db-fieldtypes ((n * 2) - 1) [
                        char [
                            s: copy* ""
                            for i 1 len 1 [
                                d: to-integer copy*/part at db-file-port o 1
                                if d <> 0 [
                                    s: join s to-char d
                                ]
                                o: o + 1
                            ]
                            append data-blk s
                        ] 
                        longint [
                            v: to-integer copy*/part at db-file-port o len
                            either v >= 0 [v: (to-integer #80000000) + v][v: v - (to-integer #80000000)]
                            append data-blk to-integer v
                            o: o + len
                        ]
                        number [
                            v: to-integer copy*/part at db-file-port o len
                            print rejoin ["v = " v]
                            either v >= 0 [v: (to-integer #80000000) + v][v: v - (to-integer #80000000)]
                            append data-blk to-integer v
                            o: o + len
                        ]                       
                        logical [
                            v: (to-integer copy*/part at db-file-port o len) - (to-integer #80)
                            append data-blk to-logic v
                            o: o + len
                        ]
                        date [
                            t: (to-integer copy*/part at db-file-port o len)                            
                            v: t - (to-integer #80000000)
                            d: 1/1/0001
                            d: d + v - 1
                            append data-blk d
                            o: o + len
                        ]
                        time [                          
                            t: (to-integer copy*/part at db-file-port o len)
                            v: t - (to-integer #80000000)
                            d: v / 1000
                            append data-blk to-time d
                            o: o + len
                        ]
                    ] [
                        s: copy* ""
                        
                        s: copy*/part at db-file-port o len
                        append data-blk s
                        o: o + len
                    ]
                ]
                append/only db-data data-blk 
            ]
            close* db-file-port
        ]
        show-header: func ["Print header of the file"] [
            print rejoin [
                'fileTypeValue " = " select fileTypeValue fileType newline
                'maxTableSize " = " select maxTableSizeValue maxTableSize maxTableSize newline
                'numRecords " = " numRecords newline
                'numFields " = " numFields newline
                'tableName " = " tableName newline
                'fileVersionID " = " second select fileVersionIDValue to-integer fileVersionID
            ]
            print ["Liste des champs :"]
            forskip db-fieldnames 1 [
                print rejoin [index? db-fieldnames " " db-fieldnames/1]
            ]
            print ["Liste des champs :"]
            forskip db-fieldtypes 2 [
                print rejoin [to-integer (index? db-fieldtypes) / 2 + 1 " " select fieldTypeValue db-fieldtypes/1 " " db-fieldtypes/2]
            ]
        ]
        show-data: func [] [
            for n 1 numRecords 1 [
                print rejoin ["=> Record n° " n] 
                data: pick* db-data n
                db-fieldnames: head db-fieldnames
                forskip db-fieldnames 1 [
                    print rejoin [tab index? db-fieldnames " " first db-fieldnames " = " pick* data index? db-fieldnames]
                ]
            ]
        ]           
    ]
    ;-----------------------------------------------------------------------------
    open: func [port [port!]][
      ;-- Say how big we are
      port/state/tail: 2000
      port/state/index: 0
      port/state/flags: port/state/flags or port-flags      
      port/locals: make locals-class []       
    db: make db-database []
        either none? port/target [
        db/db-file: to-file port/host
        ][
          db/db-file: dirize port/host
          if not none? port/path [db/db-file: join db/db-file dirize port/path]
          if not none? port/target [db/db-file: join db/db-file port/target]
          db/db-file: to-file db/db-file
        ]
        db/empty-file: not ((size? db/db-file) > 0)
        if not db/empty-file [
        db/get-header
        port/locals/columns: db/numFields
    ]
    ]
  copy: func [port [port!] /part data [integer!]][
    if not db/empty-file [
      either not port/locals/stream-end? [
            either all [value? 'part part][read-rows/part port data][read-rows port]
        ][none]
      ]
  ]
  insert: func [port [port!] data [string! block!] /local res][
        if not db/empty-file [
          either block? data [
            if empty? data [net-error "INSERT: No data !"]
            print ["INSERT data:" mold data]
        ][
            either find/any data "DESC*" [
                db/show-header
            ][
                if find/any data "SELECT*" [
                    db/get-data
                    port/locals/rownum: 0
                    port/locals/stream-end?: db/numRecords <= 0
                    port/locals/rowcount: db/numRecords
                ]
            ]
        ]
      ] 
  ]
  close: func [port [port!]][
    ;print "CLOSE"
  ]
  pick: func [port [port!] data][
        if not db/empty-file [
        either any [none? data data = 1][
            either port/locals/stream-end? [copy* []][copy/part port 1]
        ][none]
    ]
  ] 
    ;-----------------------------------------------------------------------------
    ;--- Register ourselves.
    net-utils/net-install paradox self 0
]
Notes
email address(es) have been munged to protect them from spam harvesters. If you are a Library member, you can log on and view this script without the munging.
(rb:randybeck:com)