Cobol - How to export a microfocus dll in C or Delphi

Author

How to export a microfocus dll in C or Delphi

Stephen

2006-09-21, 3:55 am

I'm in need of exporting a DLL in either Delphi or C. Delphi would be
the best.
Here is the file definition:
Questions:
Do I use stdcall or C calls?

Procedure PIBSINIT(var pc : pcT); stdcall ; external 'mio.dll';
Procedure PIBSEXIT(var pc : pcT); stdcall ; external 'edrio.dll';

Does the array name have to Match?

How do I translate 03, 05 and what does it mean?

Thanks

Stephen K. Miyasato

type
pPCT= ^pcT;
pcT = packed record //PIBS Comm
pc-version : array[0..5]of char; //6
pc-version-date : array[0..7]of char ;//8
pc-version-date : array[0..31]of char ; //32

01 pibs-comarea.
03 pc-version pic x(06).
03 pc-version-date pic x(08).
03 pc-program-name pic x(32).
03 pc-error-code pic x(03).
03 pc-first-call-flag pic x(01).
03 pc-mibs pic x(01).
03 pc-init-flag pic x(01).
03 pc-filst.
05 pc-file-status.
07 pc-fs1 pic x(01).
07 pc-fs2 pic x(01).
05 pc-fsx pic x(03).
03 filler pic x(01).
03 pc-cdate.
05 pc-cen pic x(02).
05 pc-date.
07 pc-year pic x(02).
07 pc-month pic x(02).
07 pc-day pic x(02).
03 pc-start-time pic x(04).
03 pc-file-cmd pic x(02).
03 pc-file-name pic x(24).
03 pc-next-acct-num pic x(10).
03 pc-next-pat-num pic x(10).
03 pc-debug pic x(02).
03 pc-last-closed-date pic x(08).

Tim Van Holder

2006-09-21, 7:55 am

Stephen wrote:
> I'm in need of exporting a DLL in either Delphi or C. Delphi would be
> the best.
> Here is the file definition:
> Questions:
> Do I use stdcall or C calls?

I guess that depends on how the COBOL DLLs were compiled/linked.
When in doubt, look at the exported symbols from the DLL.

> Procedure PIBSINIT(var pc : pcT); stdcall ; external 'mio.dll';
> Procedure PIBSEXIT(var pc : pcT); stdcall ; external 'edrio.dll';

> Does the array name have to Match?

No, you're just passing a point to a bunch of bytes;
the call doesn't tell the COBOL program what your local
variables are called.

> How do I translate 03, 05 and what does it mean?

The COBOL level numbers only show hierarchy

03 pc-cdate.
05 pc-cen pic x(02).
05 pc-date.
07 pc-year pic x(02).
07 pc-month pic x(02).
07 pc-day pic x(02).

defines 4 real fields, and 2 grouping names that can
be addressed in COBOL to get the concatenation of the
underlying fields. For your purposes you should see
what info you actually need. You can go for

pc-cen array[0..1] of char;
pc-year array[0..1] of char;
pc-month array[0..1] of char;
pc-day array[0..1] of char;

to give the same set of 4 field with pieces of the full
ISO date, or you could just put

pc-cdate array[0..7] of char;

Or you could make each group a separate record type.
It all depends on what parts of the commarea need to
be accessed by the Delphi code.

Alain Reymond

2006-09-21, 6:55 pm

Tim Van Holder a écrit :[color=darkred]
> Stephen wrote:

Tim,

You will find here :
http://supportline.microfocus.com/e...p#MixedLanguage

examples on how to call a cobol dll from C and from Delphi.
It is for MicroFocus of course.

Regards.

Alain

Stephen

2006-09-21, 6:55 pm

>>I guess that depends on how the COBOL DLLs were compiled/linked.[color=darkred]

How is that done? using TDUMP.exe? see below
What about the calling conversions stdcall or cdel(?);

Thanks for the reply,

I'll give it a try

Stephen K. Miyasato

TDUMP result below

DOS File Size 73000h (471040. )
Load Image Size 450h ( 1104. )
Relocation Table entry count 0000h ( 0.
Relocation Table address 0040h ( 64.
Size of header record (in paragraphs) 0004h ( 4.
Minimum Memory Requirement (in paragraphs) 0000h ( 0.
Maximum Memory Requirement (in paragraphs) FFFFh ( 65535.
File load checksum 0000h ( 0.
Overlay Number 0000h ( 0.

Initial Stack Segment (SS:SP) 0000:00B8
Program Entry Point (CS:IP) 0000:0000

Portable Executable (PE) File

Header base: 00000080

CPU type 80386
Flags 210E [ executable backwards 32bit library ]
DLL flags 0000 [ ]
Linker Version 3.0
Time stamp 428A90F4 : Tue May 17 14:48:52 2005
O/S Version 4.0
User Version 0.0
Subsystem Version 4.0
Subsystem 0002 [ Windows GUI ]
Object count 00000005
Symbols offset 00000000
Symbols count 00000000
Optional header size 00E0
Magic # 10B
Code size 00057C00
Init Data size 0003C000
Uninit Data size 00000000
Entry RVA 000586F0
Image base 61000000
Code base 00001000
Data base 00059000
Object/File align 00001000/00000200
Reserved 00000000
Image size 00097000
Header size 00000400
Checksum 00000000
Stack reserve/commit 00100000/00001000
Heap reserve/commit 00100000/00001000
Number interesting RVAs 00000010
Name RVA Size
------------------ -------- --------
Exports 00059000 0000047F
Imports 00089000 00000050
Resources 00000000 00000000
Exceptions 00000000 00000000
Security 00000000 00000000
Fixups 0008A000 0000CB7C
Debug 00000000 00000000
Description 00000000 00000000
Global Ptr 00000000 00000000
TLS 00000000 00000000
Callbacks 00000000 00000000
Bound Imports 00000000 00000000
Import Addr Table 000891C8 00000178
Delayed Imports 00000000 00000000
COM Runtime 00000000 00000000
reserved 00000000 00000000

Object table:
# Name VirtSize RVA PhysSize Phys off Flags
-- -------- -------- -------- -------- -------- --------
01 .text 00057BDA 00001000 00057C00 00000400 60000020 [CER]
02 .rdata 0000047F 00059000 00000600 00058000 40000040 [IR]
03 .data 0002E218 0005A000 0000D400 00058600 C0000040 [IRW]
04 .idata 00000702 00089000 00000800 00065A00 C0000040 [IRW]
05 .reloc 0000CD84 0008A000 0000CE00 00066200 42000040 [DIR]

Key to section flags:
C - contains code
D - discardable
E - executable
I - contains initialized data
R - readable
W - writeable

****************************************
*****************************
Section: Import
File Offset: 00065A00 (416256)
ImportLookUpTblRVA:00089074
Time Stamp: 00000000
Forwarder Chain: 00000000 (index of first forwarder reference)

Imports from cblrtss.dll
(ord. = 1475)
(ord. = 1370)
(ord. = 1477)
(hint = 0366) _mFgF806
(hint = 0365) _mFgF805
(hint = 0023) CBL_FILE_ERROR
(ord. = 1001)
(ord. = 1071)
(ord. = 1070)
(hint = 0362) _mFgF802
(ord. = 1454)
(ord. = 1460)
(hint = 0363) _mFgF803
(ord. = 1368)
(ord. = 1092)
(ord. = 1522)
(ord. = 1365)
(ord. = 1363)
(ord. = 1524)
(ord. = 1364)
(hint = 035F) _mFgCE
(ord. = 1471)
(ord. = 1359)
(ord. = 1355)
(hint = 0061) CBL_REF_EXT_DATA
(hint = 03D2) _mFiD7F5
(hint = 0359) _mFfindp
(hint = 0409) mF_eloc
(hint = 0021) CBL_EXIT_PROC
(hint = 007D) CBL_SUBSYSTEM
(hint = 0002) CBL_ALLOC_MEM
(hint = 0026) CBL_FREE_MEM
(hint = 0373) _mFgF813
(hint = 0371) _mFgF811
(hint = 0397) _mFiD791
(ord. = 1015)
(ord. = 1006)
(hint = 0064) CBL_RESNAME
(hint = 0395) _mFiD78F
(hint = 0096) CBL_TOUPPER
(hint = 0077) CBL_SETSEMA
(hint = 0062) CBL_RELSEMA
(hint = 009B) CBL_UNLOCK
(hint = 0030) CBL_GET_RECORD_LOCK
(hint = 0080) CBL_TEST_RECORD_LOCK
(hint = 0027) CBL_FREE_RECORD_LOCK
(hint = 0016) CBL_DELETE_FILE
(hint = 0008) CBL_CHECK_FILE_EXIST
(hint = 0054) CBL_OPEN_FILE
(hint = 0055) CBL_OPEN_VFILE
(hint = 0011) CBL_CREATE_FILE
(hint = 000C) CBL_CLOSE_VFILE
(hint = 000B) CBL_CLOSE_FILE
(hint = 005A) CBL_READ_FILE
(hint = 0060) CBL_READ_VFILE
(hint = 009D) CBL_WRITE_FILE
(hint = 00A6) CBL_WRITE_VFILE
(hint = 0361) _mFgF801
(hint = 0024) CBL_FLUSH_FILE
(hint = 03B9) _mFiD7CB
(hint = 000D) CBL_CMPNLS
(hint = 000E) CBL_CMPTYP
(hint = 00A7) CBL_XOR
(ord. = 1294)
(hint = 0392) _mFiD78C
(hint = 037D) _mFginitdat_dll
(ord. = 969)
(ord. = 733)
(ord. = 968)
(hint = 0353) _mFdllinit
(hint = 0354) _mFdllterm
(hint = 0357) _mFerr2
(hint = 0384) _mFgproglink
(ord. = 1464)
(ord. = 1463)
(hint = 00B6) EXTFH
(hint = 0382) _mFgprogchain
(hint = 038C) _mFgtypecheck
(hint = 035E) _mFgAE
(ord. = 1333)
(hint = 0383) _mFgprogcheckexit
(hint = 038A) _mFgprogunchain
(ord. = 1244)
(ord. = 1156)

Imports from MSVCRT40.dll
(hint = 023D) _adjust_fdiv
(hint = 041E) malloc
(hint = 02A7) _initterm
(hint = 03EB) free

Imports from KERNEL32.dll
(hint = 0137) GetVersion
(hint = 0140) GlobalAlloc
(hint = 0147) GlobalFree

****************************************
*****************************
Section: Exports
File Offset: 00058000 (360448)
Flags: 00000000
Time Stamp: 428A90F4 : Tue May 17 14:48:52 2005
Major Version: 0000
Minor Version: 0000

Exports from edrio.DLL
63 exported name(s), 63 export addresse(s). Ordinal base is 1.
Sorted by Name:
RVA Ord. Hint Name
-------- ---- ---- ----
00001000 1 0000 ACCTIO
00001DB0 3 0001 AGEBAL
000026E0 4 0002 ANOTIO
00003480 5 0003 APPTLIO
00003F80 6 0004 APPTPIO
00004C90 7 0005 APPTSIO
000058F0 8 0006 ATYPIO
00006550 9 0007 CCIIO
0000A480 11 0008 CLAIMIO
00007270 10 0009 CLMEED
0000B5A0 12 000A CLMHIO
0000C270 13 000B CLMPRTT
00010A40 14 000C CLMPSIGN
00010D30 15 000D CLMSDEL
00011670 16 000E CLMSIO
00012300 17 000F CODEIO
00013010 18 0010 CREDIO
00014450 19 0011 CRSPIO
00015050 20 0012 CUSTIO
00015B80 21 0013 DAYSIO
000168B0 22 0014 DEBITIO
00017D40 23 0015 DEBPOST
0001A4A0 24 0016 DEPIO
0001B0D0 25 0017 DXIO
0001BF20 26 0018 DXMIO
0001CC50 27 0019 DXPIO
0001D980 28 001A EMCHIO
0001E650 29 001B ERRIO
0001FF80 31 001C HIPSUBIO
0001F240 30 001D HOSPPIO
00020D10 32 001E INSCIO
00021900 33 001F INSEXTIO
00022600 34 0020 LOGINIO
000411E0 61 0021 MFFH
00023350 35 0022 MPROCIO
00024010 36 0023 NAMEIO
00024E60 37 0024 PATIIO
00025A50 38 0025 PATIO
00026720 39 0026 PATLSTIO
00027540 40 0027 PATXIO
000283B0 41 0028 PIBSEXIT
000286A0 42 0029 PIBSINIT
00029260 43 002A PLACEIO
00029F70 44 002B PMTPIO
0002ABB0 45 002C PMTPOST
0002E160 46 002D PROCDIO
0002EE70 47 002E PROCIO
0002FC60 48 002F PROVIO
000308F0 49 0030 REASNIO
00031510 50 0031 RECALIO
000321A0 51 0032 REFDRIO
00032F30 52 0033 REMPOST
00035F90 53 0034 SETUPIO
00036C80 54 0035 SMSGIO
00037870 55 0036 STMTHIO
000385D0 56 0037 STMTPRCS
00039DE0 57 0038 STMTPRT
0003EBA0 58 0039 VCODEIO
0003F850 59 003A VISIO
00057A20 63 003B XFHNAME
00041212 62 003C XFH_CLOSE
000405B0 60 003D ZIPIO
00088208 2 003E _mFcgenv

Sergey Kashyrin

2006-09-22, 6:55 pm

MicroFocus Cobol is using cdecl convention, i.e. in C++

extern "C" void __declspec(dllexport) MYFUNC(char * parm1, char * parm2,
....)

"Stephen" <miyasat@gmail.com> wrote in message
news:1158817795.522911.115330@d34g2000cwd.googlegroups.com...
> I'm in need of exporting a DLL in either Delphi or C. Delphi would be
> the best.
> Here is the file definition:
> Questions:
> Do I use stdcall or C calls?
>
> Procedure PIBSINIT(var pc : pcT); stdcall ; external 'mio.dll';
> Procedure PIBSEXIT(var pc : pcT); stdcall ; external 'edrio.dll';
>
> Does the array name have to Match?
>
> How do I translate 03, 05 and what does it mean?
>
> Thanks
>
> Stephen K. Miyasato
>
> type
> pPCT= ^pcT;
> pcT = packed record //PIBS Comm
> pc-version : array[0..5]of char; //6
> pc-version-date : array[0..7]of char ;//8
> pc-version-date : array[0..31]of char ; //32
>
> 01 pibs-comarea.
> 03 pc-version pic x(06).
> 03 pc-version-date pic x(08).
> 03 pc-program-name pic x(32).
> 03 pc-error-code pic x(03).
> 03 pc-first-call-flag pic x(01).
> 03 pc-mibs pic x(01).
> 03 pc-init-flag pic x(01).
> 03 pc-filst.
> 05 pc-file-status.
> 07 pc-fs1 pic x(01).
> 07 pc-fs2 pic x(01).
> 05 pc-fsx pic x(03).
> 03 filler pic x(01).
> 03 pc-cdate.
> 05 pc-cen pic x(02).
> 05 pc-date.
> 07 pc-year pic x(02).
> 07 pc-month pic x(02).
> 07 pc-day pic x(02).
> 03 pc-start-time pic x(04).
> 03 pc-file-cmd pic x(02).
> 03 pc-file-name pic x(24).
> 03 pc-next-acct-num pic x(10).
> 03 pc-next-pat-num pic x(10).
> 03 pc-debug pic x(02).
> 03 pc-last-closed-date pic x(08).
>

Stephen K. Miyasato

2006-10-02, 6:55 pm

I'm still having difficultly calling the microfocus dll which was written in
microfocus visual cobol for Windows 95.

Questions
1. 03 PC-FILE-CMD PIC 9(02).
What is the PIC 9(02)? can I use array[0..1] of char ?
2. The DLL does not seem to load when Delphi starts. Any idea on how to
debug?

I found this declaration in a file that was used to build a .NET DLL. I have
had difficulties trying to access the managed code hence I wish to try using
the this other dll that was made from object Cobol. The code below is from
the source I found in Cobol for .NET.

Below that I have the Delphi code that does not load the DLL. It give access
violations on load. I believe no runtime is required.

You can download the DLL from the link below;
http://www.mdsync.net/download/MIBSIO.zip

Thanks

Stephen K. Miyasato

****************************************
**************************
* *
* PIBSCOM.COP - COMMON AREA FOR PIBS SUBROUTINES. *
* *
* (C) Copyright 2005 *
* netMIBS, LLC *
* All Rights Reserved *
* *
* VERSION DATE INIT DESCRIPTION *
* ------- -------- ---- -----------------------------------------*
* V02.1 02/23/05 WHL netMIBS initial version. *
****************************************
**************************

01 PIBS-COMAREA.
03 PC-VERSION PIC X(06).
03 PC-VERSION-DATE PIC X(08).
03 PC-PROGRAM-NAME PIC X(32).
03 PC-ERROR-CODE PIC X(03).
03 pc-first-call-flag PIC X(01).
03 pc-mibs PIC X(01).
03 pc-init-flag pic x(01).
03 pc-filSt.
05 PC-FILE-STATUS.
07 pc-fs1 PIC X(01).
07 pc-fs2 PIC X(01).
05 pc-fsx pic x(03).
03 filler pic x(01).
03 pc-cdate.
05 pc-cen pic x(02).
05 pc-date.
07 pc-year pic x(02).
07 pc-month pic x(02).
07 pc-day pic x(02).
03 PC-START-TIME PIC X(04).
03 PC-FILE-CMD PIC 9(02).
03 PC-FILE-NAME PIC X(24).
03 PC-NEXT-ACCT-NUM PIC X(10).
03 PC-NEXT-PAT-NUM PIC X(10).
03 pc-debug PIC X(02).
03 pc-last-closed-date pic x(08).
03 query-comarea.
05 qc-name pic x(24).
05 qc-acct-number.
07 qc-acct-num pic x(10).
07 qc-acct-type pic x(02).
05 qc-pat-num pic x(10).
05 qc-claim-num pic x(04).
05 qc-curr-type pic 9(01).
05 qc-cmd pic x(01).
05 qc-sub-cmd pic x(01).
05 qc-function pic x(01).
05 qc-mode pic x(01).
05 qc-sub-function pic x(01).
03 qc-claim-num-arc pic x(01).
03 qc-claim-order pic x(01).
03 qc-claim-fmt pic x(01).
03 qc-trans-order pic x(01).
03 qc-trans-fmt pic x(01).
03 qc-claim-archive pic x(01).
03 qc-trans-archive pic x(01).
03 filler pic x(01).
03 pc-pmt-date pic x(08).
03 pc-chg-date pic x(08).
03 PV-MSG-LINE PIC X(54).
03 FUNCTION-KEY-DEFINITIONS.
05 FKEY-1 PIC X(06).
05 FKEY-2 PIC X(06).
05 FKEY-3 PIC X(06).
05 FKEY-4 PIC X(06).
05 FKEY-5 PIC X(06).
05 FKEY-6 PIC X(06).
05 FKEY-7 PIC X(06).
05 FKEY-8 PIC X(06).
05 FKEY-9 PIC X(06).
05 FKEY-10 PIC X(06).
03 mibs-dir pic x(36).
03 mibs-ws-dir pic x(36).
03 mibs-arc pic x(36).
03 hip-up-dir pic x(36).
03 hip-rem-dir pic x(36).
03 filler pic x(36).
03 PC-FILE-OPEN-FLAGS.
05 ACCT-OPEN-FLAG PIC X(01).
05 ACCT-TYPE-OPEN-FLAG PIC X(01).
05 CLAIM-OPEN-FLAG PIC X(01).
05 CODES-OPEN-FLAG PIC X(01).
05 CREDIT-OPEN-FLAG PIC X(01).
05 CUSTOMER-OPEN-FLAG PIC X(01).
05 DEBIT-OPEN-FLAG PIC X(01).
05 DEPT-OPEN-FLAG PIC X(01).
05 DX-OPEN-FLAG PIC X(01).
05 ERROR-OPEN-FLAG PIC X(01).
05 INS-COMPANY-OPEN-FLAG PIC X(01).
05 NAMES-OPEN-FLAG PIC X(01).
05 PAT-OPEN-FLAG PIC X(01).
05 PLACE-OPEN-FLAG PIC X(01).
05 PROC-OPEN-FLAG PIC X(01).
05 PROVIDER-OPEN-FLAG PIC X(01).
05 REFER-DR-OPEN-FLAG PIC X(01).
05 STMT-MSG-OPEN-FLAG PIC X(01).
05 ZIP-CODE-OPEN-FLAG PIC X(01).
05 temp1-open-flag PIC X(01).
05 CLAIM-HOLD-OPEN-FLAG PIC X(01).
05 DAY-STAT-OPEN-FLAG PIC X(01).
05 DAY-HIST-OPEN-FLAG PIC X(01).
05 CYCLE-OPEN-FLAG PIC X(01).
05 acct-note-open-flag pic x(01).
05 temp2-open-flag pic x(01).
05 temp3-open-flag pic x(01).
05 emc-hold-open-flag pic x(01).
05 setup-open-flag pic x(01).
05 pat-ins-open-flag pic x(01).
05 recall-open-flag pic x(01).
05 collect-open-flag pic x(01).
05 reason-open-flag pic x(01).
05 dx-edit-open-flag pic x(01).
05 proc-edit-open-flag pic x(01).
05 macro-proc-open-flag pic x(01).
05 prob-temp-open-flag pic x(01).
05 rx-open-flag pic x(01).
05 pat-rx-open-flag pic x(01).
05 arc-open-flag pic x(01).
05 log-open-flag pic x(01).
05 arc-claim-open-flag pic x(01).
05 arc-debit-open-flag pic x(01).
05 arc-credit-open-flag pic x(01).
05 claim-susp-open-flag pic x(01).
05 stmt-hist-open-flag pic x(01).
05 credit-split-open-flag pic x(01).
05 tick-open-flag pic x(01).
05 text-macro-open-flag pic x(01).
05 deposit-open-flag pic x(01).
05 pmt-prof-open-flag pic x(01).
05 prob-open-flag pic x(12).
05 appt-sum-open-flag pic x(01).
05 appt-pat-open-flag pic x(01).
05 visit-open-flag pic x(01).
05 visit-code-open-flag pic x(01).
05 patx-open-flag pic x(01).
05 vital-open-flag pic x(01).
05 author-open-flag pic x(01).
05 cci-open-flag pic x(01).
05 dx-master-open-flag pic x(01).
05 proc-dx-open-flag pic x(01).
05 login-open-flag pic x(01).
05 appt-log-open-flag pic x(01).
05 hosp-pat-open-flag pic x(01).
05 ins-ext-open-flag pic x(01).
05 hip-sub-open-flag pic x(01).
05 filler pic x(13).
03 temp1-file-name pic x(36).
03 temp2-file-name pic x(36).
03 temp3-file-name pic x(36).
03 appt-log-name pic x(36).
03 lines-per-page pic 9(02).
03 set-condensed-mode pic x(16).
03 cancel-condensed-mode pic x(16).

//Delphi code below
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
pPCT= ^pcT;
pcT = packed record //PIBS Comm
ver : array[0..5]of char; //6
verDate : array[0..7]of char ;//8
prog : array[0..31]of char ; //32
err : array[0..2]of char; //3
first : array[0..0]of char; //1first Call
mibsFlg : array[0..0]of char; //1 y MIBS is present N = no
initFlg: array[0..0]of char; //1 y means initialized new files
//rand : smallint ; //random number
filSt : array[0..4]of char ; //5
f1 : array[0..0]of char; //1
date : array[0..7]of char ; //8 char
time : array[0..3]of char ; //4
fCmd : array[0..1]of char ; //2 File command
fName: array[0..23]of char ; //24 file name
//Temp : array [0..1395] of char ;
nAcct : array[0..9]of char ; //10 Next account number
nPat : array[0..9]of char ; //10 next pat number
debug : array[0..1]of char ; //2 debug flag
lCls : array[0..7]of char ; //8 last closed date
qName : array[0..23]of char ; //24 query com are name
qAcct : array[0..11]of char ; //12 Account Number (num & type)
qPat : array[0..9]of char ; //10 pat Number
qClm : array[0..3]of char ; //4 claim number
qcurTyp : array[0..0]of char; //1 Current account type index PIC 9
qCmd : array[0..0]of char; //1 command
qCmdS : array[0..0]of char; //1 sub command
qFunc : array[0..0]of char; //1 function
qMod : array[0..0]of char; //1 mode
qFuncS : array[0..0]of char ; //1 sub function
qClaimNumArc : array[0..0]of char ; // 1 qc-Claim-num-arc
qClaimOrder : array[0..0]of char ; //1 qc-claim-order
qClaimFrm : array[0..0]of char ; // 1 qc-claim-frm
qTransOrder : array[0..0]of char ; //1 qc-trans-order
qTransFrm : array[0..0]of char ; // 1 qc-trans-frm
qClaimArch : array[0..0]of char ; // 1 qc-claim-archive
qTransArch : array[0..0]of char ; // 1 qc-trains-archive
filler : array[0..0]of char ; // 1 filler
pcPmtDate : array[0..7]of char ; // 8 pc-pmt-date
pcChgDate : array[0..8]of char ; // 8 pc-chg-date
pvMsgLine : array[0..53]of char ; // 54 PV-MSG-LINE
fKey1 : array[0..5]of char ; //Function-key-def F1
fKey2 : array[0..5]of char ; //Function-key-def F2
fKey3 : array[0..5]of char ; //Function-key-def F3
fKey4 : array[0..5]of char ; //Function-key-def F4
fKey5 : array[0..5]of char ; //Function-key-def F5
fKey6 : array[0..5]of char ; //Function-key-def F6
fKey7 : array[0..5]of char ; //Function-key-def F7
fKey8 : array[0..5]of char ; //Function-key-def F8
fKey9 : array[0..5]of char ; //Function-key-def F9
fKey10 : array[0..5]of char ; //Function-key-def F10
mibsDir: array[0..35] of char; // 36 mibs-dir
mibsWs: array[0..35] of char; // 36 mibs-ws-dir
mibsArc: array[0..35] of char; // 36 mibs-arc
hipUpDir: array[0..35] of char; //36 hip-up-dir
hipRemDir: array[0..35] of char; //36 hip-rem-dir
filler2: array[0..35] of char; // 36 filler2
AcctOpenFlag: array[0..0] of char; // 1 ACCT-OPEN-FLAG
AcctTypeOpenFlag: array[0..0] of char; // 1 ACCT-TYPE-OPEN-FLAG
ClaimOpenFlag: array[0..0] of char; // 1 CLAIM-OPEN-FLAG
CodesOpenFlag: array[0..0] of char; // 1 CODES-OPEN-FLAG
CreditOpenFlag: array[0..0] of char; // 1 CREDIT-OPEN-FLAG
CustomerOpenFlag: array[0..0] of char; // 1 CUSTOMER-OPEN-FLAG
DebitOpenFlag: array[0..0] of char; // 1 DEBIT-OPEN-FLAG
DeptOpenFlag: array[0..0] of char; // 1 DEPT-OPEN-FLAG
DxOpenFlag: array[0..0] of char; // 1 DX-OPEN-FLAG
ErrorOpenFlag: array[0..0] of char; // 1 Error-OPEN-FLAG
InsCompanyOpenFlag: array[0..0] of char; // 1 INS-COMPANY-OPEN-FLAG
NamesOpenFlag: array[0..0] of char; // 1 NAMES-OPEN-FLAG
PatOpenFlag: array[0..0] of char; // 1 PAT-OPEN-FLAG
PlaceOpenFlag: array[0..0] of char; // 1 PLACE-OPEN-FLAG
ProcOpenFlag: array[0..0] of char; // 1 PROC-OPEN-FLAG
ProviderOpenFlag: array[0..0] of char; // 1 PROVIDER-OPEN-FLAG
ReferDrOpenFlag: array[0..0] of char; // 1 REFER-DR-OPEN-FLAG
StmtOpenFlag: array[0..0] of char; // 1 STMT-OPEN-FLAG
ZipOpenFlag: array[0..0] of char; // 1 ZIP-OPEN-FLAG
Temp1OpenFlag: array[0..0] of char; // 1 temp1-OPEN-FLAG
ClaimHoldOpenFlag: array[0..0] of char; // 1 CLAIM-HOLD-OPEN-FLAG
DayStatOpenFlag: array[0..0] of char; // 1 DAY-STAT-OPEN-FLAG
DayHistOpenFlag: array[0..0] of char; // 1 DAY-HIST-OPEN-FLAG
CycleOpenFlag: array[0..0] of char; // 1 CYCLE-OPEN-FLAG
AcctNoteOpenFlag: array[0..0] of char; // 1 ACCT-NOTE-OPEN-FLAG
temp2OpenFlag: array[0..0] of char; // 1 temp2-OPEN-FLAG
temp3OpenFlag: array[0..0] of char; // 1 temp3-OPEN-FLAG
emcHoldOpenFlag: array[0..0] of char; // 1 EMC-HOLD-OPEN-FLAG
setupOpenFlag: array[0..0] of char; // 1 SETUP-OPEN-FLAG
PatInsOpenFlag: array[0..0] of char; // 1 pat-ins-OPEN-FLAG
recallOpenFlag: array[0..0] of char; // 1 recall-OPEN-FLAG
collectOpenFlag: array[0..0] of char; // 1 COLLECT-OPEN-FLAG
reasonOpenFlag: array[0..0] of char; // 1 REASON-OPEN-FLAG
dxEditOpenFlag: array[0..0] of char; // 1 dx-edit-OPEN-FLAG
procEditOpenFlag: array[0..0] of char; // 1 proc-edit-OPEN-FLAG
macroProcOpenFlag: array[0..0] of char; // 1 macro-Proc-OPEN-FLAG
probTempOpenFlag: array[0..0] of char; // 1 Prob-temp-OPEN-FLAG
rxOpenFlag: array[0..0] of char; // 1 rx-OPEN-FLAG
patRxOpenFlag: array[0..0] of char; // 1 pat-Rx-OPEN-FLAG
arcOpenFlag: array[0..0] of char; // 1 arc-OPEN-FLAG
LogOpenFlag: array[0..0] of char; // 1 log-OPEN-FLAG
arcClaimOpenFlag: array[0..0] of char; // 1 Arc-Claim-OPEN-FLAG
arcDebitOpenFlag: array[0..0] of char; // 1 arc-Debit-OPEN-FLAG
arcCreditOpenFlag: array[0..0] of char; // 1 arc-Credit-OPEN-FLAG
claimSuspOpenFlag: array[0..0] of char; // 1 Claim-susp-OPEN-FLAG
stmtHistOpenFlag: array[0..0] of char; // 1 stmt-hist-OPEN-FLAG
creditSplitOpenFlag: array[0..0] of char; // 1 Credit-split-OPEN-FLAG
tickOpenFlag: array[0..0] of char; // 1 tick-OPEN-FLAG
textMacroOpenFlag: array[0..0] of char; // 1 text-Macro-OPEN-FLAG
DepositOpenFlag: array[0..0] of char; // 1 Deposit-OPEN-FLAG
pmtProfOpenFlag: array[0..0] of char; // 1 pmt-prof-OPEN-FLAG
probOpenFlag: array[0..0] of char; // 1 prob-OPEN-FLAG
apptSumOpenFlag: array[0..0] of char; // 1 appt-sum-OPEN-FLAG
apptPatOpenFlag: array[0..0] of char; // 1 appt-Pat-OPEN-FLAG
visitOpenFlag: array[0..0] of char; // 1 visit-OPEN-FLAG
visitCodeOpenFlag: array[0..0] of char; // 1 visit-Code-OPEN-FLAG
PatxOpenFlag: array[0..0] of char; // 1 Patx-OPEN-FLAG
vitalOpenFlag: array[0..0] of char; // 1 vital-OPEN-FLAG
authorOpenFlag: array[0..0] of char; // 1 author-OPEN-FLAG
cciOpenFlag: array[0..0] of char; // 1 cci-OPEN-FLAG
dxMasterOpenFlag: array[0..0] of char; // 1 dx-master-OPEN-FLAG
procDxOpenFlag: array[0..0] of char; // 1 proc-Dx-OPEN-FLAG
loginOpenFlag: array[0..0] of char; // 1 login-OPEN-FLAG
apptLogOpenFlag: array[0..0] of char; // 1 appt-log-OPEN-FLAG
hospPatOpenFlag: array[0..0] of char; // 1 hosp-pat-OPEN-FLAG
insExtOpenFlag: array[0..0] of char; // 1 ins-ext-OPEN-FLAG
hipSubOpenFlag: array[0..0] of char; // 1 hip-OPEN-FLAG
filler3: array[0..12] of char; // 13 filler
temp1FileName: array[0..35] of char; // 36 temp1-file-name
temp2FileName: array[0..35] of char; // 36 temp2-file-name
temp3FileName: array[0..35] of char; // 36 temp3-file-name
apptLogName: array[0..35] of char; // appt-log-file-name
linesPerPage: array[0..1] of char; // 2 lines per page pic 9
cancelCondensedMode: array[0..15] of char ; // 16 cancel-condensed-mode
end;
{ pPCT= ^pcT;
pcT = packed record //PIBS Comm
ver : array[0..11]of char; //6
verDate : array[0..15]of char ;//8
prog : array[0..63]of char ; //32
err : array[0..5]of char; //3
first : array[0..1]of char; //1first Call
mibsFlg : array[0..1]of char; //1 y MIBS is present N = no
initFlg : array[0..1]of char; //1 y means initialized new files
//rand : smallint ; //random number
filSt : array[0..9]of char ; //5
f1 : array[0..1]of char; //1
date : array[0..15]of char ; //8 char
time : array[0..7]of char ; //4
fCmd : array[0..1]of char ; //2 File command
fName: array[1..47]of char ; //24 file name
nAcct : array[0..19]of char ; //10 Next account number
nPat : array[0..19]of char ; //10 next pat number
debug : array[0..1]of char ; //2 debug flag
lCls : array[0..15]of char ; //8 last closed date
qName : array[0..47]of char ; //24 query com are name
qAcct : array[0..23]of char ; //12 Account Number (num & type)
qPat : array[0..19]of char ; //10 pat Number
qClm : array[0..7]of char ; //4 claim number
qcurTyp : array[0..1]of char; //1 Current account type index
qCmd : array[0..1]of char; //1 command
qCmdS : array[0..1]of char; //1 sub command
qFunc : array[0..1]of char; //1 function
qMod : array[0..1]of char; //1 mode
qFuncS : array[0..1]of char ; //1 sub function
f2 : array[0..15]of char; //8 Flags to be later enumerated
pmtDate : array[0..15]of char; //8 payment date
chgDate : array[0..15]of char; //8 charge date
msg : array[0..107]of char ; //54 msg line
f3 : array[0..119]of char ; //60 function key defn
paths : array[0..1919]of char ; //960 file paths
// file open flags
accctOpen : array[0..1]of char;// 1
aTypOpen : array[0..1]of char; // 1
claimOpen : array[0..1]of char;// 1
open : array[0..153]of char; // 77 file open flag
f4 : array[0..143]of char ; // 72 filler
apptLogN: array[0..47]of char; // 24 appt log file name
f5 : array[0..67]of char ; // 34 filler
end;
{type
PnrT = ^nrT;
nrT = packed record //Name record
Name : array[0..47]of char ; //24 last,first m, tittle
acct : array[0..19]of char; //10
pat : array[0..19]of char ; //10
bir : array[0..15]of char ; //8 birth ccyymmdd
reg : array[0..11]of char ; //6 registration date
sex : array[0..2]of char ; //1
st : array[0..2]of char ; //1 status
loc : array[0..15]of char ; //8 location
end; }

{type
PcuT = ^cuT;
cuT = packed record //Customer record
Name : array[1..24]of char ; //24
addr1 : array[1..24]of char ; //24
addr2 : array[1..24]of char ; //24
city : array[1..20]of char ; //20
state : array[1..2]of char ; //2
zip : array[1..10]of char ; //10
phone : array[1..10]of char ; //10
fill : array[1..50]of char ; //50
acctNumLen : array[1..2]of char ; //2
patNumLen : array[1..2]of char ; //2
acctNumNext : array[1..10]of char ;//10
patNumNext : array[1..10]of char ; //10
acctNumChk : char ; //1
acctNumeric: char ; //1
patNumChk : char ; //1
patNumeric: char ; //1
acctNumAuto: char ; //1
patNumAuto : char ; //1
fil5 : char ; //2
filePaths : array[1..720]of char ;//720
fil6 : array[1..2]of char ; // 2
datelastDayRpt : array[1..8]of char ; //8 not used
fil2 : array[1..17]of char ;//17
dayRptByDr : char ; // 1
fil3 : array[1..144]of char ;//144?15
stmtRefNext : array[1..8]of char ; //8 Next stmt reference number
acctNumIncre :array[1..2]of char ; //2
patNumIncre :array[1..2]of char ; //2
fil4 : array[1..3]of char ; //3
fiscalYr : array[1..8]of char ; //8 fiscal year, next
dateLastUsed :array[1..8]of char ; //8 date system last used
fil7 : char ; //1
end; }
type
TForm1 = class(TForm)
InitCmd: TButton;
Edit1: TEdit;
Edit2: TEdit;
Nextcmd: TButton;
procedure InitCmdClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure AssignFixedString( Var FixedStr: Array of Char; Const S:
String );
end;

var
Form1: TForm1;
pc : pcT ;
// cNr : nrT ;
// cu : cuT ;
iLen : integer ;
const
Ez : string = '000';

implementation

{$R *.dfm}
{functions for edrio.dll}
Procedure initMIBS(var pc : pcT); stdcall ; external 'MIBSIO.dll';
//Procedure PIBSINIT(var pc : pcT); pascal ; external 'edrio.dll';
//Procedure PIBSEXIT(var pc : pcT); stdcall ; external 'edrio.dll';
//Procedure NAMEIO(var pc : pcT; nr : nrT);stdcall ; external 'edrio.dll';
//procedure CUSTIO(var pc : pcT; cu : cuT);stdcall ; external 'edrio.dll';

procedure TForm1.AssignFixedString( Var FixedStr: Array of Char; Const
S:String );
var
maxlen: Integer;
begin
maxlen := Succ( High( FixedStr ) - Low( FixedStr ));
FillChar( FixedStr, maxlen, ' ' ); { blank fixed string }
if Length(S) > maxlen then
Move( S[1], FixedStr, maxlen )
else if S <> '' then
Move( S[1], FixedStr, Length(S));
end;

procedure TForm1.InitCmdClick(Sender: TObject);

begin
//pc.mibsFlg := 'Y' ; //initialize whether MIBS present
AssignFixedString(pc.mibsFlg,'Y');
//pc.err := '000';
AssignFixedString(pc.err,'000');
// get common directory for all winMIBS applications
// some WinMibs directory information
//pc.fName := 'C:\MIBS5'
AssignFixedString(pc.fName,'C:\MIBS5') ;
iLen := sizeOf(pc); //..get error incompatible type 1494 in VB
//call PIBSINIT
try
//PIBSINIT(pc) ;
INITMIBS(pc); // initialize MIBS <== program exits here
except
on E : Exception do
begin
ShowMessage('Exception class name = '+E.ClassName);
// ShowMessage('Exception message = '+E.Message);
end;
end;

pc.date := '20060912' ;
//pc.chgDate := pc.chgDate ;
//pc.pmtDate := pc.pmtDate ;
pc.err := '000' ;
//CUSTIO(pc, cu);
// initialize the flags and variables

end;

end.

Sponsored Links