Script Library: 1213 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 ]
halt ;; to terminate script if DO'ne from webpage
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)