package dbase4
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file memo.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
(******* Memo File support ********) let memo_block_size = 512 let calculate_chunk_offset memo_block_size index = index * memo_block_size (******* dBase III ********) let bytes_rscan_eob bs = let n = Bytes.length bs in let rec _rscan_eob bs p = if p > 0 then if (Bytes.get_int16_le bs p) = 0x1A1A then p else _rscan_eob bs (p - 1) else -1 in _rscan_eob bs n let rec read_cblock_chn n chn pos data = let rlen = In_channel.input chn data pos n in if rlen >= 0 then let p = bytes_rscan_eob data in if p >= 0 then Bytes.sub data 0 p else read_cblock_chn n chn (pos + rlen) data else data let read_block_db3 (db : Base.dbf_file) index = match db.memo with | Some md -> let pos = calculate_chunk_offset memo_block_size index in In_channel.seek md (Int64.of_int pos); let data = read_cblock_chn memo_block_size md 0 (Bytes.make (memo_block_size * 4) '\026') in Some (Bytes.to_string data |> Bitstring.bitstring_of_string) | None -> None (******* dBase IV ********) let read_block_db4 (db : Base.dbf_file) index = match db.memo with | Some md -> if index > 0 then ( let pos = calculate_chunk_offset memo_block_size index in In_channel.seek md (Int64.of_int pos); let hdr_size = 8 in let chunk = Bitstring.bitstring_of_chan_max md hdr_size in match%bitstring chunk with | {| _mark:32:littleendian,check(_mark = Int32.of_int 589823); _len:32:littleendian,bind(Int32.to_int _len)|} -> In_channel.seek md (Int64.of_int (pos + hdr_size)); let _data = Bitstring.bitstring_of_chan_max md (_len - hdr_size) in Some _data | {| _next_free:32:littleendian,bind(Int32.to_int _next_free); _next_used:32:littleendian,bind(Int32.to_int _next_used)|} -> None | {| _ |} -> failwith "Wrong Memo chunk") else None | None -> None (* --------- *) let load_memo_internal rider (db : Base.dbf_file) index = let memo_to_dbval (obs : Bitstring.t option) = match obs with | Some data -> Bitstring.string_of_bitstring data | None -> "" in memo_to_dbval (rider db index) let load_memo (db : Base.dbf_file) index = match db.info.version with | DBASE3_with_memo -> load_memo_internal read_block_db3 db index | DBASE4_with_memo -> load_memo_internal read_block_db4 db index | _ -> ""