Type
CurrencyConnect = record
Life:Boolean;
Res: UINT;
g_idInst: DWORD;
MainTopic:PChar;
TopicMT4:HSZ;
ErrorMessageString:String;
Topic1:PChar; //QUOTE //Time //TIMESEC
TopicQUOTE:HSZ;
hCnvTopicQUOTE: DWORD;
Topic2:PChar; //BID
TopicBID:HSZ;
hCnvTopicBID: DWORD;
Topic3:PChar; //ASK
TopicASK:HSZ;
hCnvTopicASK: DWORD;
Topic4:PChar; //HIGH
TopicHIGH:HSZ;
hCnvTopicHIGH: DWORD;
Topic5:PChar; //LOW
TopicLOW:HSZ;
hCnvTopicLOW: DWORD;
end;
type
CurrencyPair = record
Life:Boolean; //Connect=True, Error/Disconnect=False
Item:PChar; //EURUSD //GBPUSD //USDJPY //AUDNZD
HSZPair:HSZ;
ErrorMessageString:String;
hDataQUOTE: HDDEDATA;
hDataBID: HDDEDATA;
hDataASK: HDDEDATA;
hDataHIGH: HDDEDATA;
hDataLOW: HDDEDATA;
Tem:PDWORD;
Result_:pbyte;
end;
Function GetDdeError(g_id: DWORD):String;
Procedure MainLoop();
Function CurrencyGethData(P_:CurrencyPair; M_:CurrencyConnect):String;
var
Form1: TForm1;
MainCurrencyConnect:CurrencyConnect;
CurrencyEURUSD:CurrencyPair;
StartLoop, Life:Boolean;
DDECallbackMessage:String;
WM_MY_MESSAGE: UINT;
Function TForm1.GetDdeError(g_id: DWORD):String;
var
DDEError: Word;
begin
GetDdeError:='';
DDEError := DdeGetLastError(g_id);
case DDEError of
DMLERR_ADVACKTIMEOUT: Result := 'Timeout on sync advise request';
DMLERR_BUSY: Result := 'Server is busy';
DMLERR_DATAACKTIMEOUT: Result := 'Timeout on sync data request';
DMLERR_DLL_NOT_INITIALIZED: Result := 'DDEML not initialised';
DMLERR_DLL_USAGE: Result := 'Invalid request';
DMLERR_EXECACKTIMEOUT: Result := 'Timeout on sync exec request';
DMLERR_INVALIDPARAMETER: Result := 'Invalid parameter in request';
DMLERR_LOW_MEMORY: Result := 'Server ran out of buffer memory';
DMLERR_MEMORY_ERROR: Result := 'Memory allocation error';
DMLERR_NO_CONV_ESTABLISHED: Result := 'No conversation established';
DMLERR_NOTPROCESSED: Result := 'Request not processed by server';
DMLERR_POKEACKTIMEOUT: Result := 'Timeout on sync poke request';
DMLERR_POSTMSG_FAILED: Result := 'PostMessage failed';
DMLERR_REENTRANCY: Result := 'Sync request already in progress';
DMLERR_SERVER_DIED: Result := 'Server died';
DMLERR_SYS_ERROR: Result := 'DDEML Internal error';
DMLERR_UNADVACKTIMEOUT: Result := 'Timeout on unadvise request';
DMLERR_UNFOUND_QUEUE_ID: Result := 'Invalid transaction ID';
end;
end;
Function DDECallback(CallType, Fmt: UINT; Conv: HConv; hsz1, hsz2: HSZ;
Data: HDDEData; Data1, Data2: DWORD): HDDEData; stdcall;
begin
Result := 0;
case CallType of
xtyp_Register:
begin
DDECallbackMessage:='xtyp_Register';
Result:=-1;
end;
xtyp_Unregister:
begin
DDECallbackMessage:='xtyp_Unregister';
Result:=-1;
end;
xtyp_xAct_Complete:
begin
DDECallbackMessage:='xtyp_xAct_Complete';
end;
xtyp_Request, Xtyp_AdvData:
begin
DDECallbackMessage:='Xtyp_AdvData';
end;
xtyp_Disconnect:
begin
DDECallbackMessage:='xtyp_Disconnect';
Result:=-1;
end;
XTYP_ERROR:
begin
DDECallbackMessage:='XTYP_ERROR';
Result:=-1;
end;
XTYP_EXECUTE:
begin
DDECallbackMessage:='XTYP_EXECUTE';
end;
XTYPF_NOBLOCK:
begin
DDECallbackMessage:='XTYPF_NOBLOCK';
Result:=-1;
end;
XTYP_CONNECT, XTYP_CONNECT_CONFIRM:
begin
DDECallbackMessage:='XTYP_CONNECT, XTYP_CONNECT_CONFIRM';
end;
XTYP_ADVREQ:
begin
//ShowMessage('XTYP_ADVREQ');
DDECallbackMessage:='XTYP_ADVREQ';
end;
xtyp_Poke:
begin
DDECallbackMessage:='xtyp_Poke';
end;
xtyp_AdvStart:
begin
DDECallbackMessage:='xtyp_AdvStart';
end;
xtyp_AdvStop:
begin
DDECallbackMessage:='xtyp_AdvStop';
end;
DMLERR_SERVER_DIED:
begin
DDECallbackMessage:='DMLERR_SERVER_DIED';
end;
DMLERR_SYS_ERROR:
begin
DDECallbackMessage:='DMLERR_SYS_ERROR';
end;
DMLERR_BUSY:
begin
DDECallbackMessage:='DMLERR_BUSY';
end;
DMLERR_DATAACKTIMEOUT:
begin
DDECallbackMessage:='DMLERR_DATAACKTIMEOUT';
end;
DMLERR_ADVACKTIMEOUT:
begin
DDECallbackMessage:='DMLERR_ADVACKTIMEOUT';
end;
end;
end;
procedure TForm1.FreeDataHandle(P_:CurrencyPair);
begin
DdeFreeDataHandle(P_.hDataQUOTE);
DdeFreeDataHandle(P_.hDataBID);
DdeFreeDataHandle(P_.hDataASK);
DdeFreeDataHandle(P_.hDataHIGH);
DdeFreeDataHandle(P_.hDataLOW);
end;
Function TForm1.CurrencyGethData(P_:CurrencyPair; M_:CurrencyConnect):String;
var
Buf: String[255];
Tem:String;
begin
Tem:=P_.Item+chr(13);
Application.ProcessMessages;
P_.hDataQUOTE := DdeClientTransaction(nil, 0, M_.hCnvTopicQUOTE, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataQUOTE<>0 then P_.Result_:=DdeAccessData(P_.hDataQUOTE,P_.Tem);
//DdeGetData(P_.hDataQUOTE, @Buf, SizeOf(Buf), 0); //DdeGetData(hData, @Buf, 255, 0);
//tem2 := Buf;
//strcopy(Result, PChar(P_.Result_));
if P_.hDataQUOTE=0 then
Tem:=Tem+'QUOTE: N/A' else Tem:=Tem+'QUOTE:'+PChar(P_.Result_)+chr(13);//Tem:='QUOTE:'+PChar(P_.Result_)+chr(13); //Tem:='QUOTE:'+tem2+chr(13);
Application.ProcessMessages;
P_.hDataBID := DdeClientTransaction(nil, 0, M_.hCnvTopicBID, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataBID<>0 then P_.Result_:=DdeAccessData(P_.hDataBID,P_.Tem);
if P_.hDataBID=0 then
Tem:=Tem+'BID: N/A' else Tem:=Tem+'BID:'+PChar(P_.Result_)+chr(13);
Application.ProcessMessages;
P_.hDataASK := DdeClientTransaction(nil, 0, M_.hCnvTopicASK, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataASK<>0 then P_.Result_:=DdeAccessData(P_.hDataASK,P_.Tem);
if P_.hDataASK=0 then
Tem:=Tem+'ASK: N/A' else Tem:=Tem+'ASK:'+PChar(P_.Result_)+chr(13);
Application.ProcessMessages;
P_.hDataHIGH := DdeClientTransaction(nil, 0, M_.hCnvTopicHIGH, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataHIGH<>0 then P_.Result_:=DdeAccessData(P_.hDataHIGH,P_.Tem);
if P_.hDataHIGH=0 then
Tem:=Tem+'HIGH: N/A' else Tem:=Tem+'HIGH:'+PChar(P_.Result_)+chr(13);
Application.ProcessMessages;
P_.hDataLOW := DdeClientTransaction(nil, 0, M_.hCnvTopicLOW, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataLOW<>0 then P_.Result_:=DdeAccessData(P_.hDataLOW,P_.Tem);
if P_.hDataLOW=0 then
Tem:=Tem+'LOW: N/A' else Tem:=Tem+'LOW:'+PChar(P_.Result_);
Result:=Tem;
Application.ProcessMessages;
FreeDataHandle(CurrencyEURUSD);
Application.ProcessMessages;
end;
procedure TForm1.MainLoop();
begin
if StartLoop = Life then exit;
Life:=StartLoop;
while StartLoop do
begin
EURUSD.Caption := CurrencyGethData(CurrencyEURUSD,MainCurrencyConnect);
if DDECallbackMessage<>'' then Label2.Caption:='Status: '+DDECallbackMessage;
Application.ProcessMessages;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StartLoop:=False;
Life:=False;
MainCurrencyConnect.g_idInst:=0;
MainCurrencyConnect.ErrorMessageString:='';
MainCurrencyConnect.MainTopic:='MT4';
MainCurrencyConnect.Topic1:='QUOTE'; //QUOTE TIME TIMESEC
MainCurrencyConnect.Topic2:='BID';
MainCurrencyConnect.Topic3:='ASK';
MainCurrencyConnect.Topic4:='HIGH';
MainCurrencyConnect.Topic5:='LOW';
CurrencyEURUSD.Item:='EURUSD';
CurrencyEURUSD.ErrorMessageString:='';
MainCurrencyConnect.Res:=DdeInitialize(@MainCurrencyConnect.g_idInst, @DdeCallback, APPCLASS_STANDARD, 0);
MainCurrencyConnect.hCnvTopicQUOTE := DdeConnect(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicMT4, MainCurrencyConnect.TopicQUOTE, nil);
MainCurrencyConnect.hCnvTopicBID := DdeConnect(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicMT4, MainCurrencyConnect.TopicBID, nil);
MainCurrencyConnect.hCnvTopicASK := DdeConnect(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicMT4, MainCurrencyConnect.TopicASK, nil);
MainCurrencyConnect.hCnvTopicHIGH := DdeConnect(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicMT4, MainCurrencyConnect.TopicHIGH, nil);
MainCurrencyConnect.hCnvTopicLOW := DdeConnect(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicMT4, MainCurrencyConnect.TopicLOW, nil);
if MainCurrencyConnect.hCnvTopicQUOTE <> 0 then
begin
DdeClientTransaction(nil, 0, MainCurrencyConnect.hCnvTopicQUOTE, CurrencyEURUSD.HSZPair, CF_TEXT, XTYP_ADVSTART, 50, nil);
end;
end;
Function TForm1.CurrencyGethData(P_:CurrencyPair; M_:CurrencyConnect):String;
var
Buf: String[255];
Tem:String;
begin
Tem:=P_.Item+chr(13);
Application.ProcessMessages;
P_.hDataQUOTE := DdeClientTransaction(nil, 0, M_.hCnvTopicQUOTE, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataQUOTE<>0 then P_.Result_:=DdeAccessData(P_.hDataQUOTE,P_.Tem);
//DdeGetData(P_.hDataQUOTE, @Buf, SizeOf(Buf), 0); //DdeGetData(hData, @Buf, 255, 0);
//tem2 := Buf;
//strcopy(Result, PChar(P_.Result_));
if P_.hDataQUOTE=0 then
Tem:=Tem+'QUOTE: N/A' else Tem:=Tem+'QUOTE:'+PChar(P_.Result_)+chr(13);//Tem:='QUOTE:'+PChar(P_.Result_)+chr(13); //Tem:='QUOTE:'+tem2+chr(13);
Application.ProcessMessages;
P_.hDataBID := DdeClientTransaction(nil, 0, M_.hCnvTopicBID, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataBID<>0 then P_.Result_:=DdeAccessData(P_.hDataBID,P_.Tem);
if P_.hDataBID=0 then
Tem:=Tem+'BID: N/A' else Tem:=Tem+'BID:'+PChar(P_.Result_)+chr(13);
Application.ProcessMessages;
P_.hDataASK := DdeClientTransaction(nil, 0, M_.hCnvTopicASK, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataASK<>0 then P_.Result_:=DdeAccessData(P_.hDataASK,P_.Tem);
if P_.hDataASK=0 then
Tem:=Tem+'ASK: N/A' else Tem:=Tem+'ASK:'+PChar(P_.Result_)+chr(13);
Application.ProcessMessages;
P_.hDataHIGH := DdeClientTransaction(nil, 0, M_.hCnvTopicHIGH, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataHIGH<>0 then P_.Result_:=DdeAccessData(P_.hDataHIGH,P_.Tem);
if P_.hDataHIGH=0 then
Tem:=Tem+'HIGH: N/A' else Tem:=Tem+'HIGH:'+PChar(P_.Result_)+chr(13);
Application.ProcessMessages;
P_.hDataLOW := DdeClientTransaction(nil, 0, M_.hCnvTopicLOW, P_.HSZPair, CF_TEXT, XTYP_REQUEST, 5000, nil);
if P_.hDataLOW<>0 then P_.Result_:=DdeAccessData(P_.hDataLOW,P_.Tem);
if P_.hDataLOW=0 then
Tem:=Tem+'LOW: N/A' else Tem:=Tem+'LOW:'+PChar(P_.Result_);
Result:=Tem;
Application.ProcessMessages;
FreeDataHandle(P_);
Application.ProcessMessages;
end;
procedure TForm1.MainLoop();
var
Tem:String;
begin
if StartLoop = Life then exit;
Life:=StartLoop;
while StartLoop do
begin
EURUSD.Caption := CurrencyGethData(CurrencyEURUSD,MainCurrencyConnect);
if DDECallbackMessage<>'' then Label2.Caption:='Status: '+DDECallbackMessage;
Application.ProcessMessages;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
StartLoop:=False;
DdeFreeStringHandle(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicQUOTE);
DdeFreeStringHandle(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicBID);
DdeFreeStringHandle(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicASK);
DdeFreeStringHandle(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicHIGH);
DdeFreeStringHandle(MainCurrencyConnect.g_idInst, MainCurrencyConnect.TopicLOW);
FreeDataHandle(CurrencyEURUSD);
end;
Recent
