#Define PATH_FLL "C:\VFP_UTILITES\COM_DLL"
 Set Library To flib.fll Additive

oCallback = NEWOBJECT("cCallback")    &&  сделали калбак
ostock= newOBJECT("comdll.test")       &&  мой Com-сервер
WITH ostock
.setcallback(oCallBack)         &&   Тут ранее связвание сделали
 .CoSetPatch(PATH_FLL)       &&   Дальше инициализация и работа
 .CoInitLib()
.CoInitPort("\\.\\COM1")
= RunComVFP(Sys( 3095 ,ostock)) 
ENDWITH

*RunComVFP - Это функция из FLL, запускает асинхронно (работает в потоке, *маршалит данные сервера на клиента и обатно) метод 
*моего сервера. Пока сделано так, есть возможность  перенести в сам сервер
*но тогда  нужно будет в сервере создать еще один интерфейс  и перенести 
* в него весть функцианал. 

DEFINE CLASS cCallback as session
   implements iCom1Events in comdllex.tlb 
   procedure iCom1Events_BeforeBuyStock()
      ? "BeforeBuyStock"
   procedure iCom1Events_AfterBuyStock(p as String) as String
      ? "Получно байт из порта ", DecToHex(p)
ENDDEFINE

Define Class Test As Session OlePublic
    pDisp = 0 
    nPort = 0 
    hCom  = 0 
    oc = .Null.
    nСadr =  0 

    Procedure Init
    This.SetCallBack(.Null., 0 )
    Endproc

****************************************
* Функция обратного вызова
* Установка функции:
* oc - объекта  чей интерфейс надо получить
* Num -  номер порта для раннего связывания с интерфейсом
****************************************
    Procedure SetCallBack(oc As Variant)
    If Isnull(oc)
        This.oc = Newobject("Com1Events")
        Return
    Endif
    If Vartype(oc) != 'O'
        Comreturnerror(Program()," Ошибка. Допускается только тип данных бъект")
        Return
    Endif
     This.oc = Getinterface(oc,"Icom1events","comdll.test")
    Endproc

*****************************************
* Ловушка собщений порта
*****************************************
    Procedure BuyStock() As Boolean
    Local lcStrIn As String
    This.oc.BeforeBuyStock() 
    lcStrIn = ReadData(This.hCom)
    This.oc.AfterBuyStock(lcStrIn)
    Endproc

    Procedure CoInitPort(cCom As String)
    This.hCom = InitCOM(cCom)
    Return  This.hCom
    Endproc

*****************************************
* Закрыть порт
*****************************************
    Procedure CoClosePort
    Return CLOSEPORT(This.hCom)
    Endproc

    Procedure CoInitLib() As Variant
    If (Atc("FLIB",Set("LIBRARY"))= 0 )
        Set Library To flib.fll Additive
    Endif
    Return  Set("LIBRARY")
    Endproc

********************************************
*  У становить путь для контрола
*  Возвращает установленный путь
********************************************
    Procedure CoSetPatch(cPatchForLibrary As Variant) As Variant
    Declare Integer GetCurrentDirectory In Win32Api Integer, String @
    Declare Integer GetSystemDirectory In Win32Api String @, Integer
    Local ln_MaxSize As Integer
    ln_MaxSize =  255 
    Local  lc_BuffSystemDir,lc_BuffCurrentDir,lc_OldPatch,;
        lc_PatchComponent,lcNewPath As String
    Store Space(ln_MaxSize) To lc_BuffSystemDir,lc_BuffCurrentDir
    GetCurrentDirectory(ln_MaxSize,@lc_BuffCurrentDir)
    GetSystemDirectory(@lc_BuffSystemDir,ln_MaxSize)
    lc_PatchComponent=Addbs(cPatchForLibrary)
    lc_OldPatch = Set("PATH")
    lcNewPath =  Addbs(Alltrim(lc_BuffCurrentDir))+";";
        +Addbs(Alltrim(lc_BuffSystemDir))+";"+;
        lc_PatchComponent+';'+;
        lc_OldPatch
    Set Path To (lcNewPath)
    Return lcNewPath
    Endproc

    Function Error(nError, cMethod, nLine)
    Comreturnerror(cMethod+'  err#='+Str(nError, 5 )+;
        '  line='+Str(nLine, 6 )+' '+Message(),_vfp.ServerName)
Enddefine

Define Class Com1Events As Session OlePublic
    Procedure BeforeBuyStock()
    Procedure AfterBuyStock(p As String) As String
    Return p
Enddefine