1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:

unit logon1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, OleCtrls, StdCtrls, SAPFunctionsOCX_TLB,
  Grids, SAPLogonCtrl_TLB, SAPLogonControl1, SAPFunctions1;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Label3: TLabel;
    Fehler: TEdit;
    Label4: TLabel;
    SAPLogonControl1: TSAPLogonControl;
    SAPFunctions1: TSAPFunctions;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1       : TForm1  ;
  Table,Funct, Connection, QuerryOptions, OptionsRow : VARIANT ;

implementation

{$R *.DFM}



procedure TForm1.Button2Click(Sender: TObject);

{Anmelden und Form vorbereiten}
begin

  Connection                   := SAPLogoncontrol1.newConnection;
  Connection.User              := Ansiuppercase('EDIUSER');
  Connection.system            := 'PSA';
  Connection.client            := '200';
  Connection.ApplicationServer := 'PSAAS003';
  Connection.SystemNumber      := '01';
  Connection.password          := 'mypwd';
  Connection.language          := 'DE'      ;

  if Connection.LogOn(0,true) = true then
  begin
   Edit3.enabled := true;
   Edit4.enabled := true;
   Button1.enabled := true;
   Button2.Visible := false;
   Fehler.Text := 'CHarge eingeben';


   end
 else
   Fehler.text := 'Logon Fehlgeschlagen';
 end;

 procedure TForm1.Button1Click(Sender: TObject);

 {Materialnummer anhand der Chargennummer ermitteln}

var Charge, TXT, txt1, Where_bedingung : string  ;
begin
   {Charge := '0000509083';}
   {Where Bedingung definieren:
    Mandat wird nicht gebraucht, weil im Logon festgelegt}
   Charge := edit4.Text;
   edit3.Text := '';
   If charge = '' then
      fehler.text := 'keine CHargennummer'
   else
    Begin
      if Connection.LogOn(0,true) = true then
        Begin
         SAPFunctions1.Connection := Connection;
         {Aufräumen}
         SapFunctions1.RemoveAll;
         {Query vorbereiten}
         Funct := SAPFunctions1.add('RFC_READ_TABLE');
         {Tabelle definieren (From Klausel)}
         Funct.exports('QUERY_TABLE').value := 'MCHA';
         {where Bedingung als Option implementieren}
         QuerryOptions := funct.tables.item('OPTIONS');
         OptionsRow := QuerryOptions.rows.add;
         fehler.text :='';
         Where_Bedingung := 'CHARG = '''+ Charge + ''''
         + ' AND lvorm <> ''X''';
         OptionsRow.Value[1]:= Where_Bedingung;
      {   RFC aufrufen und testen}
         if not Funct.call then
            fehler.text := Funct.exception
         else
         {RFC erfolgreich}
        begin
           Table := Funct.tables.item('DATA');
           If Table.rowcount <> 1 then
             Begin
                if Table.rowcount = 0 then
                   Fehler.Text := 'Charge nicht in Datenbank';

                If Table.rowcount > 1 Then
                   Fehler.Text := 'Chargennummer nicht eindeutig';
        end
           else
        Begin
         txt := Table.value(1,1);
         { der Tabelleninhalt wird als String zurückgegeben,
           die Materialnummer steht an 4, 14 lang}
         edit3.Text := copy(txt,4,14);
        end
      end
     End
   else
     Fehler.text := 'Logon Fehlgeschlagen';
  End;
end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:

library Chargendll;

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
  ExtCtrls, OleCtrls, StdCtrls, SAPFunctionsOCX_TLB, ActiveX,
  Grids, SAPLogonCtrl_TLB, SAPLogonControl1, SAPFunctions1, OleServer;

  Type
    PTC = ^TC;
    TC = class(TObject)
    SAPLogonControl1: TSAPLogonControl;
    SAPFunctions1: TSAPFunctions;
  end;

type
  PTRec = ^TREc;
  TRec = record
    CHarge      : String[10];
    Teilenummer : String[14];
    Request     : sTRING[1];
    Nachricht   : String[50];
    Rcode       : Integer;
    Status      : Integer;
    Debuggen    : Boolean;
    Form_Zeigen : Boolean;
    Anmelden    : Boolean;
  end;



  Var SAP : TC;
      angemeldet : Boolean;
      Satz : Trec;
      connection : Variant;
      Table,Funct, QuerryOptions, OptionsRow : VARIANT ;
      Charg, txt1, Where_bedingung : string  ;
      resultat : integer;

  {$R *.res}


procedure UserForm(txt : Ptrec); stdcall;
Begin
  Satz := txt^;
  if angemeldet = false then

     Begin

             sap.SAPLogonControl1.NewInstance;   { hier kommt die Zugriffsverletzung}
             connection                   := sap.SAPLogonControl1.NewConnection;
             Connection.User              := Ansiuppercase('EDIUSER');
             Connection.System            := 'PSA';
             Connection.client            := '200';
             Connection.ApplicationServer := 'PSAAS003';
             Connection.SystemNumber      :=  '01';
             Connection.password          := 'SEEBOX';
             Connection.language          := 'DE'      ;

             if Connection.LogOn(0,true) = true then
                begin
                 txt.Nachricht := 'Anmeldung erfolgt';
                 angemeldet := True;
                end
             else
                begin
                  txt.Nachricht := 'Anmeldung fehlgeschlagen';
                  angemeldet := True;
                end;
   End;

   Charg := satz.CHarge;
   txt.Nachricht := '';

   If txt.CHarge = '' then
      txt.Nachricht := 'keine CHargennummer'
   else
    Begin

         sap.SAPFunctions1.Connection := Connection;
         {Aufräumen}
         sap.SapFunctions1.RemoveAll;
         {Query vorbereiten}
         Funct := SAP.SAPFunctions1.add('RFC_READ_TABLE');
         {Tabelle definieren (From Klausel)}
         Funct.exports('QUERY_TABLE').value := 'MCHA';
         {where Bedingung als Option implementieren}
         QuerryOptions := funct.tables.item('OPTIONS');
         OptionsRow := QuerryOptions.rows.add;
         txt.Nachricht :='';
         Where_Bedingung := 'CHARG = '''+ txt.CHarge + ''''
         + ' AND lvorm <> ''X''';
         OptionsRow.Value[1]:= Where_Bedingung;
      {   RFC aufrufen und testen}
         if not Funct.call then
            txt.Nachricht := Funct.exception
         else
         {RFC erfolgreich}
        begin
           Table := Funct.tables.item('DATA');
           If Table.rowcount <> 1 then
             Begin
                if Table.rowcount = 0 then
                   txt.Nachricht := 'Charge nicht in Datenbank';

                If Table.rowcount > 1 Then
                   txt.Nachricht := 'Chargennummer nicht eindeutig';
        end
           else
        Begin
         txt1 := Table.value(1,1);
         txt.Teilenummer := copy(txt1,4,14);
        end
      end
     End
End;


  exports
  UserForm;
  
begin
 angemeldet := False;
 CoInitializeEx(nil,COINIT_MULTITHREADED);
end.