Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Delphi Example of adding and updating CONTSUPP contact records

API Examples

Delphi Example of adding and updating CONTSUPP contact records

by  richardy  Posted    (Edited  )
Heres the code from an additional contacts import program that I wrote years and years ago (Delphi 2 originally for this code). Theres not much validation in but it does show you how to search update etc. This was written for GoldMine dBase (the TOP command can really mess with SQL).




unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Edit10: TEdit;
Edit11: TEdit;
Edit12: TEdit;
Edit13: TEdit;
Edit14: TEdit;
Edit15: TEdit;
Edit16: TEdit;
Edit17: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Edit18: TEdit;
Label16: TLabel;
DdeClientConv1: TDdeClientConv;
Bevel1: TBevel;
Edit19: TEdit;
Label17: TLabel;
Edit20: TEdit;
Label18: TLabel;
Timer1: TTimer;
CheckBox2: TCheckBox;
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
Var
hC1, hCS, hIMP : String;
sInData, sResp : String;
iX, iLen : Integer;
rCount : Real;

begin

hC1 := Form1.ddeClientConv1.RequestData('[OPEN(CONTACT1)]');
hCS := Form1.ddeClientConv1.RequestData('[OPEN(CONTSUPP)]');
hIMP := Form1.ddeClientConv1.RequestData('[OPEN("'+Trim
(Form1.Edit19.Text)+'")]');
sResp := Form1.ddeClientConv1.RequestData('[MOVE
('+hC1+',SETORDER,'+Trim(Form1.Edit18.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData('[MOVE
('+hIMP+',TOP)]');
rCount := 0;
While sResp ='1' do
Begin
sResp := Form1.ddeClientConv1.RequestData('[MOVE
('+hC1+',TOP)]');
sInData := Trim(Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit20.Text)+')]'));
If (CheckBox2.Checked) and (Trim
(Form1.ddeClientConv1.RequestData('[READ('+hIMP+','+Trim
(Form1.Edit1.Text)+')]')) = ') Then
Begin
Beep;
End
Else
Begin
sResp := Form1.ddeClientConv1.RequestData('[MOVE
('+hC1+',SEEK,"'+sInData+'")]');
If sResp = '1' Then
Begin
rCount := rCount + 1;

Application.Title := Form1.ddeClientConv1.RequestData('[READ('+hIMP+','+Trim
(Form1.Edit1.Text)+')]');

sResp := Form1.ddeClientConv1.RequestData('[APPEND
('+hCS+')]');
sResp := Form1.ddeClientConv1.RequestData('[READ
('+hC1+',ACCOUNTNO)]');

sResp := Form1.ddeClientConv1.RequestData('[REPLACE
('+hCS+',ACCOUNTNO,"'+sResp+'")]');
sResp := Form1.ddeClientConv1.RequestData('[REPLACE
('+hCS+',RECTYPE,"C")]');
If Trim(Form1.Edit1.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit1.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',CONTACT,"'+sResp+'")]');
End;

If Trim(Form1.Edit2.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit2.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',TITLE,"'+sResp+'")]');
End;

If Trim(Form1.Edit3.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit3.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',CONTSUPREF,"'+sResp+'")]');
End;

If Trim(Form1.Edit4.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit4.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',ADDRESS1,"'+sResp+'")]');
End;

If Trim(Form1.Edit5.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit5.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',ADDRESS2,"'+sResp+'")]');
End;

If Trim(Form1.Edit6.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit6.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',ADDRESS3,"'+sResp+'")]');
End;

If Trim(Form1.Edit7.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit7.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',CITY,"'+sResp+'")]');
End;

If Trim(Form1.Edit8.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit8.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',STATE,"'+sResp+'")]');
End;

If Trim(Form1.Edit9.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit9.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',ZIP,"'+sResp+'")]');
End;

If Trim(Form1.Edit10.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit10.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',COUNTRY,"'+sResp+'")]');
End;

If Trim(Form1.Edit12.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit12.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',PHONE,"'+sResp+'")]');
End;

If Trim(Form1.Edit13.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit13.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',EXT,"'+sResp+'")]');
End;

If Trim(Form1.Edit14.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit14.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',FAX,"'+sResp+'")]');
End;

If Trim(Form1.Edit15.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit15.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',DEAR,"'+sResp+'")]');
End;

If Trim(Form1.Edit16.Text)<>' Then
Begin
sResp := Form1.ddeClientConv1.RequestData
('[READ('+hIMP+','+Trim(Form1.Edit16.Text)+')]');
sResp := Form1.ddeClientConv1.RequestData
('[REPLACE('+hCS+',MERGECODES,"'+sResp+'")]');
End;

// Read and write Notes
If Trim(Form1.Edit17.Text) <> ' Then
Begin
iLen := StrToInt
(0+Form1.ddeClientConv1.RequestData('[READ('+hIMP+',"LEN
('+#39+Trim(Form1.Edit17.Text)+#39+'")]'));
If iLen > 0 Then
Begin
iX := 1;
While iX < iLen do
Begin
sResp := Form1.ddeClientConv1.RequestData('[READ('+hIMP+',"SUBSTR
('+#39+Trim(Form1.Edit17.Text)+#39+','+IntToStr(iX)
+',65)"))]');
sResp :=
Form1.ddeClientConv1.RequestData('[REPLACE
('+hCS+',NOTES,"'+sResp+'")]');
iX := iX + 65;
End;
End;
End;

End
Else
Begin
End;
End;

sResp := Form1.ddeClientConv1.RequestData('[MOVE
('+hIMP+',SKIP)]');
End;

sResp := Form1.ddeClientConv1.RequestData('[CLOSE
('+hC1+')]');
sResp := Form1.ddeClientConv1.RequestData('[CLOSE
('+hCS+')]');
sResp := Form1.ddeClientConv1.RequestData('[CLOSE
('+hIMP+')]');
ShowMessage('Import Completed.');

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
If FindWindow('GMFrame',nil)<1 Then
Begin
ShowMessage('Start GoldMine First.');
Application.Terminate;
End;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
Application.ProcessMessages;
end;

end.










object Form1: TForm1
Left = 210
Top = 188
Width = 394
Height = 356
Caption = 'Simple Import Additional Contacts'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 24
Top = 8
Width = 37
Height = 13
Caption = 'Contact'
end
object Label2: TLabel
Left = 40
Top = 32
Width = 20
Height = 13
Caption = 'Title'
end
object Label3: TLabel
Left = 40
Top = 56
Width = 17
Height = 13
Caption = 'Ref'
end
object Label4: TLabel
Left = 24
Top = 80
Width = 38
Height = 13
Caption = 'Address'
end
object Label5: TLabel
Left = 40
Top = 152
Width = 17
Height = 13
Caption = 'City'
end
object Label6: TLabel
Left = 32
Top = 176
Width = 25
Height = 13
Caption = 'State'
end
object Label7: TLabel
Left = 40
Top = 200
Width = 15
Height = 13
Caption = 'Zip'
end
object Label8: TLabel
Left = 24
Top = 224
Width = 36
Height = 13
Caption = 'Country'
end
object Label9: TLabel
Left = 216
Top = 32
Width = 31
Height = 13
Caption = 'Phone'
end
object Label10: TLabel
Left = 232
Top = 80
Width = 17
Height = 13
Caption = 'Fax'
end
object Label11: TLabel
Left = 232
Top = 104
Width = 23
Height = 13
Caption = 'Dear'
end
object Label12: TLabel
Left = 224
Top = 128
Width = 30
Height = 13
Caption = 'Merge'
end
object Label13: TLabel
Left = 224
Top = 152
Width = 28
Height = 13
Caption = 'Notes'
end
object Label14: TLabel
Left = 224
Top = 8
Width = 28
Height = 13
Caption = 'E-mail'
end
object Label15: TLabel
Left = 232
Top = 56
Width = 15
Height = 13
Caption = 'Ext'
end
object Label16: TLabel
Left = 32
Top = 288
Width = 26
Height = 13
Caption = 'Index'
end
object Bevel1: TBevel
Left = 16
Top = 256
Width = 361
Height = 1
end
object Label17: TLabel
Left = 8
Top = 264
Width = 50
Height = 13
Caption = 'File n Path'
end
object Label18: TLabel
Left = 200
Top = 176
Width = 52
Height = 13
Caption = 'MatchField'
end
object Edit1: TEdit
Left = 64
Top = 8
Width = 121
Height = 21
TabOrder = 0
end
object Edit2: TEdit
Left = 64
Top = 32
Width = 121
Height = 21
TabOrder = 1
end
object Edit3: TEdit
Left = 64
Top = 56
Width = 121
Height = 21
TabOrder = 2
end
object Edit4: TEdit
Left = 64
Top = 80
Width = 121
Height = 21
TabOrder = 3
end
object Edit5: TEdit
Left = 64
Top = 104
Width = 121
Height = 21
TabOrder = 4
end
object Edit6: TEdit
Left = 64
Top = 128
Width = 121
Height = 21
TabOrder = 5
end
object Edit7: TEdit
Left = 64
Top = 152
Width = 121
Height = 21
TabOrder = 6
end
object Edit8: TEdit
Left = 64
Top = 176
Width = 121
Height = 21
TabOrder = 7
end
object Edit9: TEdit
Left = 64
Top = 200
Width = 121
Height = 21
TabOrder = 8
end
object Edit10: TEdit
Left = 64
Top = 224
Width = 121
Height = 21
TabOrder = 9
end
object Edit11: TEdit
Left = 256
Top = 8
Width = 121
Height = 21
TabOrder = 10
end
object Edit12: TEdit
Left = 256
Top = 32
Width = 121
Height = 21
TabOrder = 11
end
object Edit13: TEdit
Left = 256
Top = 56
Width = 121
Height = 21
TabOrder = 12
end
object Edit14: TEdit
Left = 256
Top = 80
Width = 121
Height = 21
TabOrder = 13
end
object Edit15: TEdit
Left = 256
Top = 104
Width = 121
Height = 21
TabOrder = 14
end
object Edit16: TEdit
Left = 256
Top = 128
Width = 121
Height = 21
TabOrder = 15
end
object Edit17: TEdit
Left = 256
Top = 152
Width = 121
Height = 21
TabOrder = 16
end
object BitBtn1: TBitBtn
Left = 216
Top = 296
Width = 75
Height = 25
TabOrder = 17
OnClick = BitBtn1Click
Kind = bkOK
end
object BitBtn2: TBitBtn
Left = 296
Top = 296
Width = 75
Height = 25
TabOrder = 18
OnClick = BitBtn2Click
Kind = bkCancel
end
object Edit18: TEdit
Left = 64
Top = 288
Width = 121
Height = 21
TabOrder = 19
Text = 'CONTKEY5'
end
object Edit19: TEdit
Left = 64
Top = 264
Width = 305
Height = 21
TabOrder = 20
end
object Edit20: TEdit
Left = 256
Top = 176
Width = 121
Height = 21
TabOrder = 21
end
object CheckBox2: TCheckBox
Left = 208
Top = 224
Width = 177
Height = 17
Caption = 'Import if contact name blank?'
TabOrder = 22
end
object DdeClientConv1: TDdeClientConv
Left = 344
Top = 200
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 312
Top = 200
end
end
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top