📄 newshtm1.pas
字号:
Width := IniFile.ReadInteger(SectionWindow, KeyWidth, Width);
Height := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);
Top := IniFile.ReadInteger(SectionWindow, KeyTop,
(Screen.Height - Height) div 2);
Left := IniFile.ReadInteger(SectionWindow, KeyLeft,
(Screen.Width - Width) div 2);
ServerEdit.Text := IniFile.ReadString(SectionData, KeyServer,
'news.vienneinfo.org');
PortEdit.Text := IniFile.ReadString(SectionData, KeyPort,
'nntp');
GroupEdit.Text := IniFile.ReadString(SectionData, KeyGroup,
'vi.test');
FromEdit.Text := IniFile.ReadString(SectionData, KeyFrom,
'first.last@company.com');
SubjectEdit.Text := IniFile.ReadString(SectionData, KeySubject,
'ICS html NNTP component');
if not LoadStringsFromIniFile(IniFileName, SectionImageFiles,
KeyImageFiles, ImageFilesMemo.Lines) then
ImageFilesMemo.Text := 'ics_logo.gif' + #13#10 + 'fp_small.gif';
if not LoadStringsFromIniFile(IniFileName, SectionPlainText,
KeyPlainText, PlainTextMemo.Lines) then
PlainTextMemo.Text :=
'This is a HTML mail message sent using ICS.' + #13#10 +
'Internet Component Suite is freeware.' + #13#10 +
'<<IMAGE1>>' + #13#10 +
'You can download ICS full source code from ' + #13#10 +
'Overbyte website <http://www.overbyte.be>.' + #13#10 +
#13#10 +
'Need to secure your applications using ICS ?' + #13#10 +
'Need to access secure web pages using HTTPS ?' + #13#10 +
'Think about contributing to the ICS-SSL effort !' + #13#10 +
'Visit the ICS-SSL website ' +
'<http://overbyte.delphicenter.com/eng/ssl.html>.' + #13#10 +
#13#10 +
'Need high performance multi-tier applications ?' + #13#10 +
'Then you need MidWare. It''s a full featured toolkit' + #13#10 +
'to build powerful N-tier applications with Delphi.' + #13#10 +
'It work equally well across the Internet or just on' + #13#10 +
'your LAN/WAN. MidWare include two sets of components:' + #13#10 +
'one to build your own application servers and one to' + #13#10 +
'build your thin custom clients. MidWare can use any' + #13#10 +
'database or even no database at all. Download full ' + #13#10 +
'source code from http://www.overbyte.be' + #13#10 + #13#10 +
'ICS and MidWare are creations of Fran鏾is Piette.' + #13#10 +
'<<IMAGE2>>' + #13#10 +
'--' + #13#10 +
'francois.piette@overbyte.be' + #13#10;
if not LoadStringsFromIniFile(IniFileName, SectionHtmlText,
KeyHtmlText, HtmlTextMemo.Lines) then
HtmlTextMemo.Text := '<HTML><BODY>' + #13#10 +
'This is a HTML mail message sent using <B>ICS</B>.<BR>' + #13#10 +
'<B>I</B>nternet <B>C</B>omponent ' +
'<B>S</B>uite is <U>freeware</U>.<BR><BR>' + #13#10 +
'<A HREF="http://www.overbyte.be">' +
'<IMG SRC="cid:IMAGE1" WIDTH=148 HEIGHT=105 BORDER=0></A><BR><BR>' + #13#10 +
'You can download ICS full source code from' + #13#10 +
'<A HREF="http://www.overbyte.be">' +
'Overbyte website</A>.<BR>' + #13#10 +
'ICS is a PostcardWare: you must send a picture postcard ' +
'to the author if you are using the code. You can find the ' +
'details in the readme.txt file.<BR><BR>' + #13#10 +
'Need to <U>secure your applications</U> using ICS ?<BR>' + #13#10 +
'Need to access secure web pages using <B>HTTPS</B> ?<BR>' + #13#10 +
'Think about contributing to the ICS-SSL effort !<BR>' + #13#10 +
'Visit the <A HREF="http://overbyte.delphicenter.com/eng/ssl.html">' +
'ICS-SSL website</A>.<BR><BR>' + #13#10 +
'Need high performance multi-tier applications ?<BR>' + #13#10 +
'Then you need <A HREF="http://www.overbyte.be">MidWare</A>. ' +
'It''s a full featured toolkit '+
'to build powerful N-tier applications with Delphi. It work ' +
'equally well across the Internet or just on your LAN/WAN. ' +
'MidWare include two sets of components: one to build your own ' +
'application servers and one to build your thin custom clients. ' +
'MidWare can use any database or even no database ' +
'at all. Download full source code from ' +
'<A HREF="http://www.overbyte.be">here</A><BR><BR>' + #13#10 +
'ICS and MidWare are creations of Fran鏾is Piette<BR>' + #13#10 +
'<A HREF="mailto:francois.piette@overbyte.be?' +
'subject=ICS%26MIDWARE">' +
'<IMG SRC="cid:IMAGE2" BORDER=0 WIDTH=92 HEIGHT=121></A>' +
'<BR>--<BR>' + #13#10 +
'<A HREF="mailto:francois.piette@overbyte.be?' +
'subject=ICS%26MIDWARE">francois.piette@overbyte.be</A>' + #13#10 +
'</BODY>' + #13#10 +
'</HTML>' + #13#10;
IniFile.Destroy;
DisplayMemo.Clear;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THtmlNewsForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create(FIniFileName);
IniFile.WriteInteger(SectionWindow, KeyTop, Top);
IniFile.WriteInteger(SectionWindow, KeyLeft, Left);
IniFile.WriteInteger(SectionWindow, KeyWidth, Width);
IniFile.WriteInteger(SectionWindow, KeyHeight, Height);
IniFile.WriteString(SectionData, KeyServer, ServerEdit.Text);
IniFile.WriteString(SectionData, KeyPort, PortEdit.Text);
IniFile.WriteString(SectionData, KeyGroup, GroupEdit.Text);
IniFile.WriteString(SectionData, KeyFrom, FromEdit.Text);
IniFile.WriteString(SectionData, KeySubject, SubjectEdit.Text);
SaveStringsToIniFile(IniFileName, SectionImageFiles,
KeyImageFiles, ImageFilesMemo.Lines);
SaveStringsToIniFile(IniFileName, SectionPlainText,
KeyPlainText, PlainTextMemo.Lines);
SaveStringsToIniFile(IniFileName, SectionHtmlText,
KeyHtmlText, HtmlTextMemo.Lines);
IniFile.Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THtmlNewsForm.Display(Msg : String);
begin
DisplayMemo.Lines.BeginUpdate;
try
if DisplayMemo.Lines.Count > 200 then begin
while DisplayMemo.Lines.Count > 200 do
DisplayMemo.Lines.Delete(0);
end;
DisplayMemo.Lines.Add(Msg);
finally
DisplayMemo.Lines.EndUpdate;
SendMessage(DisplayMemo.Handle, EM_SCROLLCARET, 0, 0);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THtmlNewsForm.HtmlNntpClientRequestDone(
Sender : TObject;
RqType : TNntpRequest;
ErrorCode : Word);
begin
{ For every operation, we display the status }
if (ErrorCode > 0) and (ErrorCode < 10000) then
Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
' Error='+ HtmlNntpClient.ErrorMessage)
else
Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
' Error='+ IntToStr(ErrorCode));
if not FRunning then
Exit;
{ Start next operation, but first check if previous one was OK }
if ErrorCode <> 0 then begin
FRunning := FALSE; { Terminate All-In-One demo }
Display('Error, stop.');
Exit;
end;
case RqType of
nntpConnect: HtmlNntpClient.Group(GroupEdit.Text);
nntpGroup: HtmlNntpClient.Post(nil);
nntpPost: HtmlNntpClient.Quit;
nntpQuit: begin
Display('Done !');
FRunning := FALSE;
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THtmlNewsForm.PostButtonClick(Sender: TObject);
begin
DisplayMemo.Clear;
HtmlNntpClient.PlainText := PlainTextMemo.Lines;
HtmlNntpClient.HtmlText := HtmlTextMemo.Lines;
HtmlNntpClient.AttachedFiles := ImageFilesMemo.Lines;
HtmlNntpClient.Host := ServerEdit.Text;
HtmlNntpClient.Port := PortEdit.Text;
HtmlNntpClient.HdrSubject := SubjectEdit.Text;
HtmlNntpClient.HdrFrom := FromEdit.Text;
HtmlNntpClient.HdrGroup := GroupEdit.Text;
FRunning := TRUE;
HtmlNntpClient.Connect;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THtmlNewsForm.HtmlNntpClientDisplay(
Sender : TObject;
MsgBuf : Pointer;
MsgLen : Integer);
begin
Display('> ' + StrPas(MsgBuf));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THtmlNewsForm.HtmlNntpClientSessionConnected(
Sender : TObject;
ErrCode : Word);
begin
Display('Session connected');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THtmlNewsForm.Button1Click(Sender: TObject);
begin
Display(SplitQuotedPrintableString(EncodeQuotedPrintable(
'12345678901234567890123456789012345678901234567890123456789012345678901234567890' +
'12345678901234567890123456789012345678901234567890123456789012345⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -