mirror of
https://github.com/moparisthebest/Simba
synced 2025-02-07 02:30:19 -05:00
More GUI changes
I started to work on a Bug Report form, but came to the conclusion, have no way of posting the information. Wizzup, could you please post on the new thread about how to post to Mantis if you know? I wrote up some new code for a new internets.pas currently in (newinternets.pas, whooda thunk?) Its good, just needs some crucial things like physically openning the connections and closing them. I added PostHTTP stuff, and need more ideas, I worked through Indy and found the right things so.. yeah! Oh, and I added some more icons to the MainMenu from famfam. Just to reiterate, the new AboutForm is a template, and the Image is copyrighted and will have to change. git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@406 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Nava2
parent
3095e37472
commit
bedc0fa2a5
@ -66,6 +66,8 @@ begin
|
||||
AboutMemo.Lines.Add('');
|
||||
AboutMemo.Lines.Add('Simba is released under the GPL license.');
|
||||
AboutMemo.Lines.Add(format('You are currently using version: %d',[Testunit.SimbaVersion]));
|
||||
AboutMemo.Lines.Add('');
|
||||
AboutMemo.Lines.Add('Please report bugs at: http://mufasa.villavu.com/mantis/');
|
||||
end;
|
||||
|
||||
procedure TAboutForm.OkButtonClick(Sender: TObject);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -30,9 +30,9 @@ uses
|
||||
cthreads, cmem,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
LResources ,
|
||||
Forms, testunit, colourhistory, About, internets, debugimage,
|
||||
framefunctionlist, simpleanalyzer, updater, updateform, simbasettings;
|
||||
LResources, Forms, testunit, colourhistory, About, internets, debugimage,
|
||||
framefunctionlist, simpleanalyzer, updater, updateform, simbasettings,
|
||||
reportbug;
|
||||
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
|
||||
|
||||
begin
|
||||
@ -46,6 +46,7 @@ begin
|
||||
Application.CreateForm(TDebugImgForm, DebugImgForm);
|
||||
Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm);
|
||||
Application.CreateForm(TSettingsForm, SettingsForm);
|
||||
Application.CreateForm(TFormReportBug, FormReportBug);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
|
||||
170
Projects/SAMufasaGUI/reportbug.lfm
Normal file
170
Projects/SAMufasaGUI/reportbug.lfm
Normal file
@ -0,0 +1,170 @@
|
||||
object FormReportBug: TFormReportBug
|
||||
Left = 563
|
||||
Height = 400
|
||||
Top = 164
|
||||
Width = 600
|
||||
ActiveControl = MemoSummary
|
||||
Caption = 'Report a Bug'
|
||||
ClientHeight = 400
|
||||
ClientWidth = 600
|
||||
LCLVersion = '0.9.29'
|
||||
object ButtonReport: TButton
|
||||
Left = 16
|
||||
Height = 25
|
||||
Top = 368
|
||||
Width = 75
|
||||
Caption = 'Report'
|
||||
OnClick = ButtonReportClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object MemoDescription: TMemo
|
||||
Left = 9
|
||||
Height = 168
|
||||
Top = 192
|
||||
Width = 300
|
||||
TabOrder = 1
|
||||
end
|
||||
object LabelTitle: TLabel
|
||||
Left = 10
|
||||
Height = 20
|
||||
Top = 12
|
||||
Width = 105
|
||||
Caption = 'Report a Bug'
|
||||
Font.Height = -17
|
||||
Font.Name = 'Sans'
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object GroupBoxReportData: TGroupBox
|
||||
Left = 328
|
||||
Height = 318
|
||||
Top = 42
|
||||
Width = 264
|
||||
Caption = 'Report Data'
|
||||
ClientHeight = 299
|
||||
ClientWidth = 260
|
||||
TabOrder = 2
|
||||
object ComboBoxCategory: TComboBox
|
||||
Left = 9
|
||||
Height = 29
|
||||
Top = 21
|
||||
Width = 237
|
||||
ItemHeight = 0
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Select Category'
|
||||
'Bitmaps'
|
||||
'Client-Image Core'
|
||||
'Code Completion'
|
||||
'Colour History'
|
||||
'Colour Picker'
|
||||
'Colour Recognition'
|
||||
'DTM'
|
||||
'File System'
|
||||
'Function List'
|
||||
'General'
|
||||
'GUI'
|
||||
'Input '
|
||||
'Internet Functions'
|
||||
'Other'
|
||||
'Python'
|
||||
'Scripting Engine'
|
||||
)
|
||||
TabOrder = 0
|
||||
Text = 'Select Category'
|
||||
end
|
||||
object ComboBoxReproducibility: TComboBox
|
||||
Left = 9
|
||||
Height = 29
|
||||
Top = 93
|
||||
Width = 237
|
||||
ItemHeight = 0
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Reproducibility'
|
||||
'Always'
|
||||
'Sometimes'
|
||||
'Random'
|
||||
'Have not tried'
|
||||
'Unable to Reproduce'
|
||||
'N/A'
|
||||
)
|
||||
TabOrder = 1
|
||||
Text = 'Reproducibility'
|
||||
end
|
||||
object ComboBoxSeverity: TComboBox
|
||||
Left = 9
|
||||
Height = 29
|
||||
Top = 173
|
||||
Width = 237
|
||||
BidiMode = bdRightToLeftReadingOnly
|
||||
ItemHeight = 0
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Severity'
|
||||
'Feature'
|
||||
'Trivial'
|
||||
'Text'
|
||||
'Tweak'
|
||||
'Minor'
|
||||
'Major'
|
||||
'Crash'
|
||||
'Block'
|
||||
)
|
||||
ParentBidiMode = False
|
||||
TabOrder = 2
|
||||
Text = 'Severity'
|
||||
end
|
||||
object ComboBoxPriority: TComboBox
|
||||
Left = 9
|
||||
Height = 29
|
||||
Top = 253
|
||||
Width = 237
|
||||
ItemHeight = 0
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Priority'
|
||||
'None'
|
||||
'Low'
|
||||
'Normal'
|
||||
'High'
|
||||
'Urgent'
|
||||
'Immediate'
|
||||
)
|
||||
TabOrder = 3
|
||||
Text = 'Priority'
|
||||
end
|
||||
end
|
||||
object MemoSummary: TMemo
|
||||
Left = 9
|
||||
Height = 89
|
||||
Top = 64
|
||||
Width = 300
|
||||
TabOrder = 3
|
||||
end
|
||||
object LabelSummary: TLabel
|
||||
Left = 10
|
||||
Height = 18
|
||||
Top = 42
|
||||
Width = 102
|
||||
Caption = 'Breif Summary:'
|
||||
ParentColor = False
|
||||
end
|
||||
object LabelDescription: TLabel
|
||||
Left = 10
|
||||
Height = 18
|
||||
Top = 168
|
||||
Width = 79
|
||||
Caption = 'Description:'
|
||||
ParentColor = False
|
||||
end
|
||||
object ButtonCancel: TButton
|
||||
Left = 420
|
||||
Height = 25
|
||||
Top = 368
|
||||
Width = 171
|
||||
Caption = 'Cancel'
|
||||
OnClick = ButtonCancelClick
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
76
Projects/SAMufasaGUI/reportbug.pas
Normal file
76
Projects/SAMufasaGUI/reportbug.pas
Normal file
@ -0,0 +1,76 @@
|
||||
unit reportbug;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, StdCtrls, Controls, Graphics, Dialogs, LResources,
|
||||
ComCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TFormReportBug }
|
||||
|
||||
TFormReportBug = class(TForm)
|
||||
ButtonCancel: TButton;
|
||||
ButtonReport: TButton;
|
||||
ComboBoxCategory: TComboBox;
|
||||
ComboBoxPriority: TComboBox;
|
||||
ComboBoxReproducibility: TComboBox;
|
||||
ComboBoxSeverity: TComboBox;
|
||||
GroupBoxReportData: TGroupBox;
|
||||
LabelSummary: TLabel;
|
||||
LabelDescription: TLabel;
|
||||
LabelTitle: TLabel;
|
||||
MemoSummary: TMemo;
|
||||
MemoDescription: TMemo;
|
||||
procedure ButtonCancelClick(Sender: TObject);
|
||||
procedure ButtonReportClick(Sender: TObject);
|
||||
private
|
||||
// mantis page
|
||||
PostPage: String;
|
||||
URLFormat: String;
|
||||
function PostReport: Boolean;
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
FormReportBug: TFormReportBug;
|
||||
|
||||
implementation
|
||||
uses
|
||||
httpsend;
|
||||
{ TFormReportBug }
|
||||
|
||||
procedure TFormReportBug.ButtonCancelClick(Sender: TObject);
|
||||
begin
|
||||
Self.ModalResult := mrCancel;
|
||||
Self.Hide;
|
||||
end;
|
||||
|
||||
function TFormReportBug.postReport: Boolean;
|
||||
begin
|
||||
// newinternets.pas will allow this to work! :D
|
||||
result := false;
|
||||
end;
|
||||
|
||||
procedure TFormReportBug.ButtonReportClick(Sender: TObject);
|
||||
begin
|
||||
{ Send Report Data }
|
||||
{
|
||||
need to implement the sending of data, I am assuming that mantis uses POST
|
||||
variables when sending data, but I do not know. This needs to be found out.
|
||||
}
|
||||
Writeln('HAI YOU CLICKED THE BUTTON!');
|
||||
Self.postReport;
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I reportbug.lrs}
|
||||
|
||||
end.
|
||||
|
||||
@ -8,7 +8,7 @@ object Form1: TForm1
|
||||
ClientHeight = 532
|
||||
ClientWidth = 734
|
||||
KeyPreview = True
|
||||
Menu = MainMenu1
|
||||
Menu = MainMenu
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
@ -422,16 +422,18 @@ object Form1: TForm1
|
||||
ClientWidth = 150
|
||||
OnEndDock = nil
|
||||
TabOrder = 3
|
||||
DesignTop = 219
|
||||
inherited FunctionList: TTreeView
|
||||
Height = 244
|
||||
Top = 22
|
||||
Width = 150
|
||||
DefaultItemHeight = 19
|
||||
OnChange = FunctionListChange
|
||||
OnDeletion = nil
|
||||
OnEnter = FunctionListEnter
|
||||
OnExit = FunctionListExit
|
||||
end
|
||||
inherited editSearchList: TEdit
|
||||
Height = 27
|
||||
Top = 266
|
||||
Width = 150
|
||||
OnExit = editSearchListExit
|
||||
@ -439,11 +441,12 @@ object Form1: TForm1
|
||||
OnKeyPress = editSearchListKeyPress
|
||||
end
|
||||
inherited FunctionListLabel: TLabel
|
||||
Height = 18
|
||||
Width = 146
|
||||
end
|
||||
end
|
||||
end
|
||||
object MainMenu1: TMainMenu
|
||||
object MainMenu: TMainMenu
|
||||
left = 488
|
||||
top = 144
|
||||
object MenuFile: TMenuItem
|
||||
@ -1261,9 +1264,85 @@ object Form1: TForm1
|
||||
object MenuHelp: TMenuItem
|
||||
Caption = '&Help'
|
||||
object MenuItemAbout: TMenuItem
|
||||
Caption = '&About'
|
||||
Caption = 'About'
|
||||
Bitmap.Data = {
|
||||
36040000424D3604000000000000360000002800000010000000100000000100
|
||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00AD744423AC72417DAA703FDBA86D3CF3A76B3AF3A569
|
||||
37DBA468357DA3663323FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00B57E5153B37C4EE6D7BBA3FFE9DACAFFECE0D1FFECE0D1FFE8D8
|
||||
C8FFD3B59CFFA76C3AE6A66A3853FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00BD895F53BB875BF4E7D5C4FFE5D2BFFFC9A685FFB88E67FFB68A65FFC5A1
|
||||
80FFE0CCBAFFE3D0BEFFAB7040F4A96E3D53FFFFFF00FFFFFF00FFFFFF00C695
|
||||
6D22C3926AE5EAD8C9FFE3CDBAFFC0946BFFBA8C62FFCFB094FFCFB094FFB789
|
||||
5FFFB28761FFDAC0AAFFE4D1C0FFAE7546E5AD734322FFFFFF00FFFFFF00CC9E
|
||||
787EE4CCB9FFEAD6C5FFC79971FFBF9066FFBF9066FFF7F1ECFFF6F0EAFFB789
|
||||
5FFFB7895FFFB58963FFE2CEBBFFD9BDA6FFB27B4D7EFFFFFF00FFFFFF00D3A7
|
||||
84DBEFE1D3FFD9B595FFC7986CFFC39569FFC19367FFBF9066FFBF9066FFBB8B
|
||||
63FFB98A63FFB88A62FFCBA786FFEADCCCFFB88357DBFFFFFF00FFFFFF00D9B0
|
||||
8FF6F2E4D9FFD1A57AFFC5996BFFC4976AFFC49669FFFAF6F2FFF3EAE1FFC295
|
||||
6DFFBE8F65FFBE8F64FFC0956DFFEFE3D5FFBF8C61F6FFFFFF00FFFFFF00E0B9
|
||||
99F6F2E5DAFFD1A67EFFCC9D71FFC79A6CFFC5986BFFE2CCB6FFF8F3EEFFF6EE
|
||||
E8FFD9BDA1FFC29468FFC59B71FFF0E2D6FFC5956CF6FFFFFF00FFFFFF00E6C1
|
||||
A3DBF3E5D9FFDFBB9EFFCFA075FFCD9E72FFF5EBE3FFE4CBB4FFE7D3BFFFFBF8
|
||||
F6FFE5D3BFFFC4986BFFD6B491FFEEE0D2FFCC9E78DBFFFFFF00FFFFFF00EBC9
|
||||
AD7EF4E3D4FFEFDCCDFFD5A87EFFD0A077FFFBF8F5FFFCF8F5FFFCF8F5FFFBF8
|
||||
F5FFD1A881FFCFA47BFFEAD5C3FFEAD4C2FFD2A7837EFFFFFF00FFFFFF00F1D0
|
||||
B522EFCEB3E5F6E9DDFFECD8C6FFD7AC81FFDCBB9AFFF6ECE3FFF5ECE2FFE4C8
|
||||
AEFFD2A77BFFE6CEBAFFF1E2D5FFDBB391E5D9B08E22FFFFFF00FFFFFF00FFFF
|
||||
FF00F4D4BB53F2D2B8F4F7EADFFFEEDED0FFE3C1A7FFD8AE89FFD7AC86FFDDBB
|
||||
9CFFEBD6C7FFF3E6D9FFE3BE9FF4E1BB9C53FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00F6D8BF53F5D6BDE6F9E9DCFFF6E8DDFFF3E5DAFFF3E5DAFFF5E7
|
||||
DCFFF5E4D6FFEBC8ACE6E9C6A953FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00F9DBC423F8DAC27DF7D8C0DBF6D7BEF3F4D5BCF3F3D3
|
||||
B9DBF1D1B77DF0CFB423FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
||||
}
|
||||
OnClick = MenuItemAboutClick
|
||||
end
|
||||
object MenuItemReportBug: TMenuItem
|
||||
Caption = 'Report a Bug'
|
||||
Bitmap.Data = {
|
||||
36040000424D3604000000000000360000002800000010000000100000000100
|
||||
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00328AC5EC3087C4F62F85C3F62D83C2F62A80
|
||||
BBFF297EBAFF287DBFF6267BBEF62579BDF62377BDF62276BCC3FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF003891C9E4DDECF6FFBDEEF9FFACEAF8FFABEA
|
||||
F8FFABEAF8FFABEAF8FFADEAF8FFD4F3FBFFA4C8E4FF267BBEABFFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00338781C88EC2E1FF97E8F9FF61DCF6FF5BDB
|
||||
F5FF3288C2FF5BDBF5FF6ADEF6FFB1E7F6FF2D83C2E92B81C12AFFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF002A7B2EC12B7A32FF4A9FBCFFABDBEFFF74E0F7FF58DA
|
||||
F5FF58DAF5FF5DDBF5FF90E6F8FF92C1E1FF2F84B090FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF002F8733C1207423FF94C09DFF62AC99FF7BBDDFFFA2EAF9FF61DC
|
||||
F6FF3187C2FF77E1F7FFB6DEF0FF3890BCE93891C90DFFFFFF00FFFFFF00FFFF
|
||||
FF0035923A872D8C32FF77B582FF4D9E54FF79B38DFF4DA7AEFFACD9ECFF82E3
|
||||
F8FF3388C2FFACEDFAFF439ECFFE419BCE53FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00329537F562AD68FF77BE91FF44A05DFF4B9F53FF72B499FF51AECFFFB4EB
|
||||
F8FF8EE6F8FFB5DDEEFF3E969FFF2B784D17FFFFFF002066237CFFFFFF00FFFF
|
||||
FF00339C38F852A959FF6DBC8CFF4DAA70FF429F5CFF4CA254FF6DBBB8FFA4D7
|
||||
EBFFDCF4FBFF55B0D3FF2F824EFF247328FE237027FF226C26FFFFFFFF0034A4
|
||||
39C733A138FF339E38FF94CFACFF5CB47EFF4EAC72FF41A15DFF4FA75EFF60BB
|
||||
D2FFABDBEDFF6CBABDFF2A7E2DFF26792AF42576296DFFFFFF0037AD3CFA36AA
|
||||
3BFF35A73AA238A53EEA50AD56FF8DCCA5FF5EB580FF4FAD73FF42A35DFF55B1
|
||||
86FF69C0D3FF8ABF9BFF29832EFF25593BAFFFFFFF00FFFFFF0038B13EF137AF
|
||||
3D23FFFFFF00FFFFFF0034A63AFE39A53FFF90CEA8FF62B984FF58B27BFF60B2
|
||||
76FF38973EFF29892DFF57A462FF265044DBFFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF0037AE3D4136AB3CFF38A93EF045AC4BFF9ED4ADFFA4D7B8FF85C3
|
||||
8EFF288F2DFF4FB75FFF97C8AAFF2C8D31FF2B8930FF2A852EFFFFFFFF00FFFF
|
||||
FF00FFFFFF0038B33EF038B13DF8FFFFFF0038AC3DF135A83AFF34A539FF34A1
|
||||
39FF72C27EFFAFE3C2FF5F8C78FF32654D75FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF003AB740FF39B53F74FFFFFF00FFFFFF0037AD3CF836AA3BED467F
|
||||
66A53A8650F7339D3AFE3B715889FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF003BBB4123FFFFFF00FFFFFF00FFFFFF0038B23EFF37AF3DB24E8E
|
||||
6A2235A93B6534A63AF2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003AB73FFF39B43F41FFFF
|
||||
FF0037AE3D5236AC3CF7FFFFFF00FFFFFF00FFFFFF00FFFFFF00
|
||||
}
|
||||
OnClick = MenuItemReportBugClick
|
||||
end
|
||||
end
|
||||
end
|
||||
object Mufasa_Image_List: TImageList
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -39,7 +39,7 @@ uses
|
||||
SynExportHTML,
|
||||
SynEditKeyCmds, SynEditHighlighter, SynEditMarkupSpecialLine,SynEditMarkupHighAll,
|
||||
SynEditMiscClasses, LMessages, Buttons, PairSplitter,about, framefunctionlist,
|
||||
ocr, updateform, simbasettings;
|
||||
ocr, updateform, simbasettings, reportbug;
|
||||
|
||||
const
|
||||
SimbaVersion = 404;
|
||||
@ -91,11 +91,14 @@ type
|
||||
CheckBoxMatchCase: TCheckBox;
|
||||
frmFunctionList: TFunctionListFrame;
|
||||
LabeledEditSearch: TLabeledEdit;
|
||||
MainMenu: TMainMenu;
|
||||
Memo1: TMemo;
|
||||
MenuFile: TMenuItem;
|
||||
MenuEdit: TMenuItem;
|
||||
MenuHelp: TMenuItem;
|
||||
MenuExtra: TMenuItem;
|
||||
MenuItemAbout: TMenuItem;
|
||||
MenuItemReportBug: TMenuItem;
|
||||
MenuViewSettings: TMenuItem;
|
||||
MenuItemExportHTML: TMenuItem;
|
||||
MenuItemDivider9: TMenuItem;
|
||||
@ -111,7 +114,6 @@ type
|
||||
MenuItemFunctionList: TMenuItem;
|
||||
MenuItemHide: TMenuItem;
|
||||
MenuItemDebugImage: TMenuItem;
|
||||
MenuItemAbout: TMenuItem;
|
||||
MenuItemMainExit: TMenuItem;
|
||||
MenuItemDivider6: TMenuItem;
|
||||
PopupItemReplace: TMenuItem;
|
||||
@ -252,6 +254,7 @@ type
|
||||
procedure MenuItemExportHTMLClick(Sender: TObject);
|
||||
procedure MenuitemFillFunctionListClick(Sender: TObject);
|
||||
procedure MenuItemHideClick(Sender: TObject);
|
||||
procedure MenuItemReportBugClick(Sender: TObject);
|
||||
procedure MenuItemShowClick(Sender: TObject);
|
||||
procedure MenuItemTabCloseClick(Sender: TObject);
|
||||
procedure MenuItemTabCloseOthersClick(Sender: TObject);
|
||||
@ -1476,6 +1479,11 @@ begin
|
||||
Self.hide;
|
||||
end;
|
||||
|
||||
procedure TForm1.MenuItemReportBugClick(Sender: TObject);
|
||||
begin
|
||||
FormReportBug.Show;
|
||||
end;
|
||||
|
||||
procedure TForm1.MenuItemShowClick(Sender: TObject);
|
||||
begin
|
||||
Self.Show;
|
||||
|
||||
@ -13,6 +13,7 @@ implementation
|
||||
uses
|
||||
httpsend;
|
||||
|
||||
{ OTHER }
|
||||
function GetPage(URL: String): String;
|
||||
var
|
||||
s: TStringList;
|
||||
|
||||
303
Units/MMLAddon/newinternets.pas
Normal file
303
Units/MMLAddon/newinternets.pas
Normal file
@ -0,0 +1,303 @@
|
||||
unit newinternets;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
const
|
||||
POSTVARS_VARIABLE = 0;
|
||||
POSTVARS_VALUE = 1;
|
||||
|
||||
type
|
||||
{
|
||||
Store the internet connection information
|
||||
}
|
||||
TInternetConnection = class(TObject)
|
||||
protected
|
||||
//url of the connection
|
||||
ConnURL: String;
|
||||
//contains post paramaters and vars
|
||||
PostVars: array [0..1] of TStringArray;
|
||||
PostFreeSpots: array of Integer;
|
||||
PostVarsLen, PostVarsHigh, FreeSpotsHigh, FreeSpotsLen : integer;
|
||||
public
|
||||
constructor Create(URL: String);
|
||||
destructor Destroy; override;
|
||||
//POST variable functions for PHP transmission
|
||||
procedure PostVariableAdd(theVar, theValue: String);
|
||||
procedure PostVariableDel(theVar: String);
|
||||
procedure PostVariableReplace(searchVar, replaceVar, value: String);
|
||||
function PostHTTP: Boolean;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
TInternetArray = class(TObject)
|
||||
protected
|
||||
FreeSpots: array of Integer;
|
||||
ConnArray: array of TInternetConnection;
|
||||
ConnHigh, FreeSpotsHigh, FreeSpotsLen : integer;
|
||||
|
||||
public
|
||||
function ConnectionOpen(URL: String): Integer;
|
||||
function ConnectionClose(ConnInd: Integer): Boolean;
|
||||
destructor Destroy; override;
|
||||
//POST variable functions for PHP transmission
|
||||
procedure PostVariableAdd(connInd: Integer; theVar, theValue: String);
|
||||
procedure PostVariableDel(connInd: Integer; theVar: String);
|
||||
procedure PostVariableReplace(connInd: Integer; searchVar, replaceVar, value: String);
|
||||
function PostHTTP(connInd: Integer): Boolean;
|
||||
end;
|
||||
|
||||
function GetPage(URL: String): String;
|
||||
|
||||
implementation
|
||||
uses
|
||||
httpsend;
|
||||
|
||||
|
||||
function replace(sStr, rStr, iStr: String): String;
|
||||
var
|
||||
ind: Integer;
|
||||
begin
|
||||
ind := Pos(sStr, iStr);
|
||||
while (ind <> 0) do
|
||||
begin
|
||||
Delete(iStr, ind, Length(sStr));
|
||||
Insert(rStr, iStr, ind);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TInternetConnection }
|
||||
|
||||
procedure TInternetConnection.Create(URL: String);
|
||||
begin
|
||||
inherited;
|
||||
Self.ConnURL := URL;
|
||||
end;
|
||||
|
||||
procedure TInternetConnection.Destroy; overload;
|
||||
begin
|
||||
inherited;
|
||||
// ADD CLOSING OF CONNECTION
|
||||
|
||||
// is this all necessary? Memory leaks etc trying to avoid them :p
|
||||
setLength(PostVars[POSTVARS_VARIABLE], PostVars[POSTVARS_VALUE], 0);
|
||||
setLength(PostFreeSpots, 0);
|
||||
FreeSpotsHigh := -1;
|
||||
FreeSpotsLen := 0;
|
||||
PostVarsHigh := -1;
|
||||
PostVarsLen := 0;
|
||||
end;
|
||||
|
||||
procedure TInternetConnect.PostVariableAdd(theVar, theValue: String);
|
||||
var
|
||||
currentIndex: Integer;
|
||||
begin
|
||||
theVar := replace(' ', '%20', theVar); // more needs to be done, I only knew the ' ' replace.
|
||||
theValue := replace(' ', '%20', theValue);
|
||||
with Self do
|
||||
begin
|
||||
if (FreeSpotsHigh = -1) then
|
||||
begin
|
||||
setLength(PostVars[POSTVARS_VARIABLE], PostVars[POSTVARS_VALUE], PostVarsHigh + 2);
|
||||
inc(PostVarsHigh);
|
||||
currentIndex := PostVarsHigh;
|
||||
end else
|
||||
begin
|
||||
currentIndex := PostFreeSpots[FreeSpotsHigh];
|
||||
dec(FreeSpotsHigh);
|
||||
end;
|
||||
PostVars[POSTVARS_VARIABLE][currentIndex] := theVar;
|
||||
PostVars[POSTVARS_VALUE][currentIndex] := theValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TInternetConnection.PostVariableDel(theVar: String);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := PostVarHigh downto 0 do
|
||||
begin
|
||||
if (theVar = Self.PostVars[POSTVARS_VARIABLE][i]) then
|
||||
begin
|
||||
with Self do
|
||||
begin
|
||||
PostVars[POSTVARS_VARIABLE][i] := '';
|
||||
PostVars[POSTVARS_VALUE][i] := '';
|
||||
if (FreeSpotsHigh = FreeSpotsLen) then
|
||||
begin
|
||||
FreeSpotsLen := FreeSpotsLen + 1;
|
||||
setLength(PostFreeSpots, FreeSpotsLen);
|
||||
end;
|
||||
PostFreeSpots[FreeSpotsHigh] := i;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TInternetConnection.PostVariableReplace(searchVar, replaceVar, value: String);
|
||||
var
|
||||
i: Integer;;
|
||||
begin
|
||||
with Self do
|
||||
begin
|
||||
for i := PostVarHigh downto 0 do
|
||||
begin
|
||||
if (searchVar = PostVars[POSTVARS_VARIABLE][i]) then
|
||||
begin
|
||||
PostVars[POSTVARS_VARIABLE][i] := replaceVar;
|
||||
PostVars[POSTVARS_VALUE][i] := value;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TInternetConnection.PostHTTP: Boolean;
|
||||
var
|
||||
// holds the vars when they are placed together
|
||||
URLData: String;
|
||||
theStream: TStream;
|
||||
begin
|
||||
try
|
||||
with Self do
|
||||
begin
|
||||
//ADD Connection stuffs
|
||||
|
||||
for i := PostVarsHigh downto 0 do
|
||||
begin
|
||||
if (PostVars[POSTVARS_VARIABLE] <> '') then
|
||||
begin
|
||||
URLData := URLData + format('%d=%d+', [PostVars[POSTVARS_VARIABLE][i],
|
||||
PostVars[POSTVARS_VALUE][i]]);
|
||||
end;
|
||||
end;
|
||||
Delete(URLData, Length(URLData) - 1, 1);
|
||||
|
||||
{I DONT KNOW (TStream), this should work since we don't reuse it after.}
|
||||
HttpPostURL(ConnURL, URLData, theStream);
|
||||
|
||||
// Lets remove all Post Variable data so fresh start next time.
|
||||
setLength(PostVars[POSTVARS_VARIABLE], PostVars[POSTVARS_VALUE], 0);
|
||||
setLength(PostFreeSpots, 0);
|
||||
FreeSpotsHigh := -1;
|
||||
FreeSpotsLen := 0;
|
||||
PostVarsHigh := -1;
|
||||
PostVarsLen := 0;
|
||||
end;
|
||||
except
|
||||
raise Exception.createFMT('TInternetConnection.PostHTTP: Something went wrong, could not complete. (%d)', URLData);
|
||||
exit(false);
|
||||
end;
|
||||
result := true;
|
||||
end;
|
||||
|
||||
{ TInternetArray }
|
||||
|
||||
{
|
||||
Allocate space in the ConnArray, then open the connection.
|
||||
}
|
||||
function TInternetArray.ConnectionOpen(URL: String): Integer;
|
||||
var
|
||||
currentIndex: Integer;
|
||||
begin
|
||||
with Self do
|
||||
begin
|
||||
if (FreeSpotsHigh = -1) then
|
||||
begin
|
||||
setLength(ConnArray, ConnHigh + 2);
|
||||
inc(ConnHigh);
|
||||
currentIndex := ConnHigh;
|
||||
end else
|
||||
begin
|
||||
currentIndex := FreeSpots[FreeSpotsHigh];
|
||||
dec(FreeSpotsHigh);
|
||||
end;
|
||||
ConnArray[currentIndex].Create(URL);
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
Close the connection, add the index to the FreeSpots.
|
||||
}
|
||||
function TInternetArray.ConnectionClose(theInd: Integer): Boolean;
|
||||
begin
|
||||
try
|
||||
with Self do
|
||||
begin
|
||||
ConnArray[theInd].Destroy;
|
||||
if (FreeSpotsHigh = FreeSpotsLen) then
|
||||
begin
|
||||
FreeSpotsLen := FreeSpotsLen + 1;
|
||||
setLength(FreeSpots, FreeSpotsLen);
|
||||
end;
|
||||
FreeSpots[FreeSpotsHigh] := theInd;
|
||||
end;
|
||||
except
|
||||
raise Exception.createFMT('TInternetArray.ConnectionClose: Could not close connection %d URL: %d',
|
||||
[theInd, ConnArray[theInd].ConnURL]);
|
||||
exit(false);
|
||||
end;
|
||||
result := True;
|
||||
end;
|
||||
|
||||
{
|
||||
Wrapper for the TInternetConnection.PostVariableAdd procedure which accepts
|
||||
a connection index.
|
||||
}
|
||||
procedure TInternetArray.PostVariableAdd(connInd: Integer; theVar, theValue: String);
|
||||
begin
|
||||
try
|
||||
result := ConnArray[connInd].PostVariableAdd(theVar, theValue);
|
||||
except
|
||||
raise Exception.createFMT('TInternetArray.PostVariableAdd: %d is not in the ConnArray',
|
||||
[connInd]);
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
Wrapper for the TInternetConnection.PostVariableDel procedure which accepts
|
||||
a connection index.
|
||||
}
|
||||
procedure TInternetArray.PostVariableDel(connInd: Integer; theVar: String);
|
||||
begin
|
||||
try
|
||||
result := ConnArray[connInd].PostVariableAdd(theVar);
|
||||
except
|
||||
raise Exception.createFMT('TInternetArray.PostVariableDel: %d is not in the ConnArray',
|
||||
[connInd]);
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
Wrapper for the TInternetConnection.PostVariableReplace procedure which accepts
|
||||
a connection index.
|
||||
}
|
||||
procedure TInternetArray.PostVariableReplace(connInd: Integer; searchVar, replaceVar, value: String);
|
||||
begin
|
||||
try
|
||||
result := ConnArray[connInd].PostVariableAdd(searchVar, replaceVar, value);
|
||||
except
|
||||
raise Exception.createFMT('TInternetArray.PostVariableReplace: %d is not in the ConnArray',
|
||||
[connInd]);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ OTHER }
|
||||
function GetPage(URL: String): String;
|
||||
var
|
||||
s: TStringList;
|
||||
begin
|
||||
s:=TStringList.Create;
|
||||
HttpGetText(URL, s);
|
||||
result := String(s.GetText);
|
||||
s.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user