Source file: /~heha/BETA/matdde32.zip/SRC/DDEPOKE.PAS

library ddepoke;
uses PasMex32,Windows,DDEML,dde_init;
{jede dieser DLLs auf andere Basisadressen relozieren}
{$IMAGEBASE $10030000}

procedure CopyFloatXl(indata,dp: PDouble; x,y:LongInt);
{Durchgehende Doubles in XlTable-Doubles umwandeln}
 begin
  PrepareXlTable(dp,x,y);
  x:=x*y;			{Rollentausch: x=gesamt, y=Block}
  while x>0 do begin
   y:=SkipXlFloatHeader(dp);
   CopyMemory(dp,indata,y*sizeof(Double));
   Inc(dp,y); Inc(indata,y); Dec(x,y);
  end;
 end;

procedure mexFunction(nlhs:LongInt; var plhs:TMatArr;
  nrhs:LongInt; const prhs:TMatArr); stdcall;
 var
  conv: HConv;
  item: Hsz;
  indata,data: PChar;	{data kann, muss aber kein String sein!}
  datalen,cf: UInt;
  format: EClip;
  timeout: LongInt;
  inchar: Bool;
  lp: PLongInt;
  dp: PDouble absolute lp;
  x,y: LongInt;		{Matrix-Ausdehnung}
{Mehr-als-zwei-dimensionale Matrizen können nur mit CF_MatTable
 übertragen werden}
 begin
  TestInputArgs(nrhs,prhs,3,5,$0E,$1D);	{ncbbn}
  conv:=Round(mxGetScalar(prhs[0]));
  item:=ArrayToStringHandle(prhs[1]);
  inchar:=mxIsChar(prhs[2]);
  cf:=CF_Text; format:=Text;
  if nrhs>=4 then format:=CheckClipFormat(prhs[3],cf,nil);
			{testen & umwandeln in 1, 2 oder 3}
  timeout:=StdTimeOut;
  if nrhs=5 then timeout:=Round(mxGetScalar(prhs[4]));

  data:=nil;	{Compiler ist blind wegen fehlendem CASE-ELSE-Zweig...}

  if inchar then begin
   indata:=mxArrayToString(prhs[2]);	{"verschluckt" Unicodes}
   case format of
    Text: begin
     data:=indata;			{nicht schaufeln!}
     datalen:=lstrlen(data)+1;
    end;
    Unicode: begin
     data:=Alloc_Datalen(format,x,y,datalen);	{indata verwerfend}
     mxGetStringW(prhs[2],PWChar(data),datalen);
    end;
    XlTable: begin
     str_count_numbers(indata,x,y);
     data:=Alloc_Datalen(format,x,y,datalen);
     dp:=Pointer(data);
     PrepareXlTable(dp,x,y);
     str_to_numbers(indata,x,y,dp,true);	{alles umwandeln!}
     PutWarn(18);			{Schwachsinn-Meldung}
    end;
    MatTable: begin
     str_count_numbers(indata,x,y);
     data:=Alloc_Datalen(format,x,y,datalen);
     lp:=Pointer(data);
     lp^:=LongInt(mxDouble_Class); inc(lp);	{nur DOUBLE}
     if (x=1) and (y=1) then lp^:=0	{nulldimensional = Skalar}
     else begin
      lp^:=2; inc(lp);			{Dimensionen (fest bei Matrizen)}
      lp^:=y; inc(lp);
      lp^:=x;
     end;
     inc(lp);
     str_to_numbers(indata,x,y,dp,false);	{alles umwandeln!}
     PutWarn(18);			{Schwachsinn-Meldung}
    end;
   end;
  end else begin
   PDouble(indata):=mxGetPr(prhs[2]);	{Delphi sollte hier (weg)optimieren}
   x:=mxGetN(prhs[2]);
   y:=mxGetM(prhs[2]);
   datalen:=mxGetNumberOfDimensions(prhs[2]);
   case format of
    Text: begin
     if datalen>2 then PutErr(15);	{kann nicht umsetzen Dims>2}
     data:=Alloc_datalen(format,x,y,datalen);
     str_from_numbers(data,x,y,PDouble(indata),false);
    end;
    Unicode: PutErr(17);		{Kann nicht / will nicht}
    XlTable: begin
     if datalen>2 then PutErr(15);	{kann nicht umsetzen Dims>2}
     data:=Alloc_Datalen(format,x,y,datalen);
     CopyFloatXl(PDouble(indata),PDouble(data),x,y);
    end;
    MatTable: begin
     x:=datalen;
     y:=mxGetNumberOfElements(prhs[2]);
     datalen:=(2+x)*sizeof(LongInt)+y*sizeof(Double);
     data:=PChar(LocalAlloc(LMEM_Fixed,datalen));
     lp:=Pointer(data);
     lp^:=LongInt(mxDouble_Class); inc(lp);	{z.Z. nur DOUBLE}
     lp^:=x; inc(lp);			{Dimensionen (fest bei Text)}
     CopyMemory(lp,mxGetDimensions(prhs[2]),x*sizeof(LongInt));
     inc(lp,x);
     CopyMemory(dp,indata,y*sizeof(Double));
    end;
   end{case};
  end{else};

  plhs[0]:=mxCreateDoubleMatrix(1,1,mxReal);
  mxGetPr(plhs[0])^:=LongInt(DdeClientTransaction(
    data,datalen,conv,item,cf,XTYP_Poke,timeout,nil)<>0);
    {BOOL-Rückgabe}
  mxSetLogical(plhs[0]);			{neu bei Matlab5}
  FreeStringHandle(item);
  if inchar then mxFree(indata);
  if (not inchar) or (format<>Text) then LocalFree(Integer(data));
  HandleDdeError(0);		{falls etwas schiefging: anzeigen!}
 end;

exports
 mexFunction;
begin
 DisableThreadLibraryCalls(HInstance);
end.