Autor Beitrag
Marco D.
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 2750

Windows Vista
Delphi 7, Delphi 2005 PE, PHP 4 + 5 (Notepad++), Java (Eclipse), XML, XML Schema, ABAP, ABAP OO
BeitragVerfasst: Di 27.09.05 11:32 
Kann man den Inhalt der Zwischenablage irgendwie über TCpServer an TCP Client senden?


Moderiert von user profile iconKlabautermann: Topic aus Sonstiges verschoben am Di 27.09.2005 um 12:10

_________________
Pascal keeps your hand tied. C gives you enough rope to hang yourself. C++ gives you enough rope to shoot yourself in the foot
Hansi@OMG
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 304

Vista
Delphi 2006 Prof., Lazarus
BeitragVerfasst: Fr 30.09.05 13:03 
Und zwar so:
Das ist der Code, den du in beiden Programmen brauchst:
ausblenden volle Höhe Delphi-Quelltext
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:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
uses clipbrd;

procedure CopyStreamToClipboard(fmt: Cardinal; S: TStream);
var
  hMem: THandle;
  pMem: Pointer;
begin
  Assert(Assigned(S));
  S.Position := 0;
  hMem       := GlobalAlloc(GHND or GMEM_DDESHARE, S.Size);
  if hMem <> 0 then
  begin
    pMem := GlobalLock(hMem);
    if pMem <> nil then
    begin
      try
        S.Read(pMem^, S.Size);
        S.Position := 0;
      finally
        GlobalUnlock(hMem);
      end;
      Clipboard.Open;
      try
        Clipboard.SetAsHandle(fmt, hMem);
      finally
        Clipboard.Close;
      end;
    end { If }
    else
    begin
      GlobalFree(hMem);
      OutOfMemoryError;
    end;
  end { If }
  else
    OutOfMemoryError;
end{ CopyStreamToClipboard }

procedure CopyStreamFromClipboard(fmt: Cardinal; S: TStream);
var
  hMem: THandle;
  pMem: Pointer;
begin
  Assert(Assigned(S));
  hMem := Clipboard.GetAsHandle(fmt);
  if hMem <> 0 then
  begin
    pMem := GlobalLock(hMem);
    if pMem <> nil then
    begin
      try
        S.Write(pMem^, GlobalSize(hMem));
        S.Position := 0;
      finally
        GlobalUnlock(hMem);
      end;
    end { If }
    else
      raise Exception.Create('CopyStreamFromClipboard: could not lock global handle ' +
        'obtained from clipboard!');
  end{ If }
end{ CopyStreamFromClipboard }

procedure SaveClipboardFormat(fmt: Word; writer: TWriter);
var
  fmtname: array[0..128of Char;
  ms: TMemoryStream;
begin
  Assert(Assigned(writer));
  if 0 = GetClipboardFormatName(fmt, fmtname, SizeOf(fmtname)) then
    fmtname[0] := #0;
  ms := TMemoryStream.Create;
  try
    CopyStreamFromClipboard(fmt, ms);
    if ms.Size > 0 then
    begin
      writer.WriteInteger(fmt);
      writer.WriteString(fmtname);
      writer.WriteInteger(ms.Size);
      writer.Write(ms.Memory^, ms.Size);
    end{ If }
  finally
    ms.Free
  end{ Finally }
end{ SaveClipboardFormat }

procedure LoadClipboardFormat(reader: TReader);
var
  fmt: Integer;
  fmtname: string;
  Size: Integer;
  ms: TMemoryStream;
begin
  Assert(Assigned(reader));
  fmt     := reader.ReadInteger;
  fmtname := reader.ReadString;
  Size    := reader.ReadInteger;
  ms      := TMemoryStream.Create;
  try
    ms.Size := Size;
    reader.Read(ms.memory^, Size);
    if Length(fmtname) > 0 then
      fmt := RegisterCLipboardFormat(PChar(fmtname));
    if fmt <> 0 then
      CopyStreamToClipboard(fmt, ms);
  finally
    ms.Free;
  end{ Finally }
end{ LoadClipboardFormat }

procedure SaveClipboard(S: TStream);
var
  writer: TWriter;
  i: Integer;
begin
  Assert(Assigned(S));
  writer := TWriter.Create(S, 4096);
  try
    Clipboard.Open;
    try
      writer.WriteListBegin;
      for i := 0 to Clipboard.formatcount - 1 do
        SaveClipboardFormat(Clipboard.Formats[i], writer);
      writer.WriteListEnd;
    finally
      Clipboard.Close;
    end{ Finally }
  finally
    writer.Free
  end{ Finally }
end{ SaveClipboard }

procedure LoadClipboard(S: TStream);
var
  reader: TReader;
begin
  Assert(Assigned(S));
  reader := TReader.Create(S, 4096);
  try
    Clipboard.Open;
    try
      clipboard.Clear;
      reader.ReadListBegin;
      while not reader.EndOfList do
        LoadClipboardFormat(reader);
      reader.ReadListEnd;
    finally
      Clipboard.Close;
    end{ Finally }
  finally
    reader.Free
  end{ Finally }
end{ LoadClipboard }


Dann schaut dein Client so aus:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
procedure TForm1.Button1Click(Sender: TObject);
var ms: TmemoryStream;
begin
idtcpclient1.Host:=edit1.text;
ms:=tfilestream.Create();
  try

    idtcpclient1.Connect(2000);
    idtcpclient1.WriteLn('getclipboard');
    idtcpclient1.ReadStream(ms);
    idtcpclient1.Disconnect;
    loadclipboard(ms);

  except
  end;
ms.free;
end;


und dein Server so:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var  ms: TMemoryStream;
begin
  if athread.Connection.ReadLn() = 'getclipboard' then begin
     ms := TMemoryStream.Create;
      saveclipboard(ms);
      athread.Connection.OpenWriteBuffer();
      athread.Connection.WriteStream(ms,true);
      athread.Connection.CloseWriteBuffer;
      ms.free;
  end;
athread.Connection.Disconnect;
end;


Alles unter Indy 9!!!
Du musst natürlich noch den Defaultport am Server und den Port am Client einstellen, aber dann sollte das funktionieren.

_________________
Who doesn't know the Micrsoft developer "Mahatma Fatal Error"?
digi_c
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 1905

W98, XP
D7 PE, Lazarus, WinAVR
BeitragVerfasst: Fr 30.09.05 14:19 
Marco D. Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 2750

Windows Vista
Delphi 7, Delphi 2005 PE, PHP 4 + 5 (Notepad++), Java (Eclipse), XML, XML Schema, ABAP, ABAP OO
BeitragVerfasst: Fr 30.09.05 17:02 
Titel: C
@ Hansi@OMG: Hey mann das ich hier gleich den Code bekomme damit hätte ich ja nicht gerechnet ... :wink:

Auf jeden Fall dankeschön!

Werds gleich mal ausprobieren!!

Greetz KOler

_________________
Pascal keeps your hand tied. C gives you enough rope to hang yourself. C++ gives you enough rope to shoot yourself in the foot