dfm - Page 2 - Developer IT

What's wrong with this code to un-camel-case a string?

- by omair iqbal

Here is my attempt to solve the About.com Delphi challenge to un-camel-case a string. unit challenge1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type check = 65..90; TForm1 = class(TForm) Edit1: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; var s1,s2 :string; int : integer; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var i: Integer; checks : set of check; begin s1 := edit1.Text; for i := 1 to 20 do begin int :=ord(s1[i]) ; if int in checks then insert(' ',s1,i-1); end; showmessage(s1); end; end. check is a set that contains capital letters so basically whenever a capital letter is encountered the insert function adds space before its encountered (inside the s1 string), but my code does nothing. ShowMessage just shows text as it was entered in Edit1. What have I done wrong?

Read the article

Why the composite component fails to parent controls?

- by lyborko

Hi, I created my own Component : TPage , which Contains Subcomponent TPaper (TPanel). The problem is, that when I put controls such as TMemo or TButton on the TPaper (which fills up nearly whole area), the controls do not load at all. see example below TPaper = class(TPanel) protected constructor Create(AOwner: TComponent);override; destructor Destroy;override; public procedure Paint; override; end; TPage = class(TCustomControl) private FPaper:TPaper; protected procedure CreateParams(var Params:TCreateParams); override; public constructor Create(AOwner: TComponent);override; destructor Destroy;override; published property Paper: TPaper read FPaper write FPaper; end; constructor TPage.Create(AOwner: TComponent); begin inherited Create(AOwner); PaperOrientation:=poPortrait; PaperSize:=psA4; PaperBrush:=TBrush.Create; PaperBrush.Color:=clWhite; PDFDocument:=Nil; FPaper:=TPaper.Create(Self); FPaper.Parent:=Self; FPaper.SetSubComponent(True); end; ... Memo1 is parented in TPaper (TPanel) at design-time, but after pressing "Run" it does not exist. procedure TForm1.btn1Click(Sender: TObject); begin if not Assigned(Memo1) then ShowMessage('I do not exist'); //Memo1 is nil end; Have you any idea what's wrong? Thanks a lot P.S Delphi 7 When I put TMemo inside TPaper and save the unit (Unit1), after inspection of associated dfm file, there is no trace of TMemo component. (Thats why it can not load to app.)

Read the article

How can I display a form for set configuration before the main form?

- by Hamidm

hello, in my project i have two form's(form1,form2), form1 is configuration form. i want to show Form1 and when we click Button1 then show Form2 and free(Release) Form1. how can to i do this? i use this code. but this project start and then exit automatically.A Friend said because the application message loop never start, and application terminates because main form does not exist. how i can to solve this problem? uses Unit2; {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Application.CreateForm(TForm2, Form2); Release; end; /// program Project1; uses Forms, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2}; {$R *.res} begin Application.Initialize; Application.MainFormOnTaskbar := True; Form1:= TForm1.Create(Application); Application.Run; end.

Read the article

Delphi - TPerlRegEx / RegExBuddy Problem

- by Brad

I've got a problem with RegEx and Delphi 2k9 (Win32). I get the following Error: First chance exception at $7C812AFB. Exception class Exception with message 'TPerlRegEx.Compile() - Please specify a regular expression in RegEx first'. I've got the latest version of TPerlRegEx from the website. Using its defualt settings (Using DLL) I'm including demo source code. It's using the code generated by RegExBuddy, latest version. http://www.4shared.com/file/236428923/97478b61/googleresultstestdata.html http://www.4shared.com/file/236439483/e0acbe6d/Unit2.html Delphi FORM http://www.4shared.com/file/236439473/6734a2a2/Unit2.html Delphi PAS Thanks for any help -Brad Data is from Google External Keyword Tool RegEx could use some refinement... but works in RegExBuddy not in Delphi unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, PerlRegEx; type TForm2 = class(TForm) Memo1: TMemo; Memo2: TMemo; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.dfm} procedure TForm2.Button1Click(Sender: TObject); var Regex: TPerlRegEx; GroupIndex: Integer; begin Regex := TPerlRegEx.Create(nil); Regex.RegEx := 'criteria.push(new kpCriterion('(?P(.?))', (?P(.?)),'#13#10'''(?P(.?))'', ''(?P(.?))'', (?P(.?)), (?P(.?)), (.+)'#13#10','#13#10''\$(?P(.?))', (?P(.?)),'#13#10''(?P(.?))', (?P(.*+))'; Regex.Options := [preMultiLine]; Regex.Subject := memo1.text; if Regex.Match then begin memo2.Lines.Add('Matches Found'); repeat for GroupIndex := 0 to Regex.SubExpressionCount do begin memo2.lines.add( Regex.SubExpressions[GroupIndex]); //Add Results to memo // backreference text: Regex.SubExpressions[GroupIndex]; // backreference start: Regex.SubExpressionOffsets[GroupIndex]; // backreference length: Regex.SubExpressionLengths[GroupIndex]; end; until not Regex.MatchAgain; end else memo2.Lines.Add('No-Matches Found'); end; end. DFM object Form2: TForm2 Left = 0 Top = 0 Caption = 'Form2' ClientHeight = 247 ClientWidth = 480 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo Left = 8 Top = 8 Width = 185 Height = 89 Lines.Strings = ( 'var showImpressions = false; var ' 'criteriaSuggestor = ' ''sensei_keyword'; var ' 'historicalTimePeriod = 'Mar ' '2009 - Feb 2010'; var ' 'historicalStartMonth = 2; var ' 'impressionTimePeriod = ' ''February'; var ' 'criteriaGroupsArray = new Array(); ' 'var captchaError = false; var ' 'quotaExceeded = false;' 'var criteria = new Array();' 'var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.4' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' '));' 'criteria.push(new ' 'kpCriterion('thunderstorm' '9;, 1.9117305278778076,' #39'201,000'#39', '#39'550,000'#39', 201000, ' '550000, 0.8666667' ',' ''$0.49', 493102,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.42' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.46' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.36' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' '));' 'criteria.push(new ' 'kpCriterion('[thunderstorm]&' '#39;, 1.9117305278778076,' #39'33,100'#39', '#39'90,500'#39', 33100, 90500, ' '0.8666667' ',' ''$0.49', 493102,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '3' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.4' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' '));' 'criteria.push(new ' 'kpCriterion('\42thunderstorm\' '042', 1.9117305278778076,' #39'201,000'#39', '#39'450,000'#39', 201000, ' '450000, 0.8666667' ',' ''$0.49', 493102,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.64' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.56' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.53' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.58' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' '));' 'criteria.push(new ' 'kpCriterion('thunderstorms&#' '39;, 1.8268921375274658,' #39'110,000'#39', '#39'201,000'#39', 110000, ' '201000, 0.8' ',' ''$0.56', 559074,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.83' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.42' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.41' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.56' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.39' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.51' '));' 'criteria.push(new ' 'kpCriterion('[thunderstorms]&' '#39;, 1.8268921375274658,' #39'22,200'#39', '#39'40,500'#39', 22200, 40500, ' '0.8' ',' ''$0.56', 559074,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.64' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.56' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.53' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.58' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' '));' 'criteria.push(new ' 'kpCriterion('\42thunderstorms' '\042', 1.8268921375274658,' #39'110,000'#39', '#39'165,000'#39', 110000, ' '165000, 0.8' ',' ''$0.56', 559074,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.71' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.92' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' '));' 'criteria.push(new ' 'kpCriterion('lightning ' 'storm', 1.774579644203186,' #39'49,500'#39', '#39'90,500'#39', 49500, 90500, ' '0.73333335' ',' ''$0.54', 535666,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.97' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.98' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.84' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.86' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' '));' 'criteria.push(new ' 'kpCriterion('[lightning ' 'storm]', 1.774579644203186,' #39'12,100'#39', '#39'22,200'#39', 12100, 22200, ' '0.73333335' ',' ''$0.54', 535666,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.72' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.85' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.92' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.71' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.65' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' '));' 'criteria.push(new ' 'kpCriterion('\42lightning ' 'storm\042', ' '1.774579644203186,' #39'33,100'#39', '#39'60,500'#39', 33100, 60500, ' '0.73333335' ',' ''$0.54', 535666,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.71' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.66' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.74' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.72' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' '));' 'criteria.push(new ' 'kpCriterion('rain storm', ' '1.7464053630828857,' #39'27,100'#39', '#39'49,500'#39', 27100, 49500, ' '0.6666667' ',' ''$0.53', 526334,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '0' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.55' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.74' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.89' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' '));' 'criteria.push(new ' 'kpCriterion('[rain ' 'storm]', ' '1.7464053630828857,' #39'5,400'#39', '#39'8,100'#39', 5400, 8100, ' '0.6666667' ',' ''$0.53', 526334,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '2' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.72' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.62' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.59' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.66' '));' 'criteria.push(new ' 'kpCriterion('\42rain ' 'storm\042', ' '1.7464053630828857,' #39'14,800'#39', '#39'27,100'#39', 14800, 27100, ' '0.6666667' ',' ''$0.53', 526334,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '0' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.78' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.84' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.92' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' '));' 'criteria.push(new ' 'kpCriterion('lightning ' 'storms', ' '1.6842896938323975,' #39'14,800'#39', '#39'27,100'#39', 14800, 27100, ' '0.73333335' ',' ''$0.42', 417108,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.9' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.9' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.84' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.88' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.63' '));' 'criteria.push(new ' 'kpCriterion('[lightning ' 'storms]', ' '1.6842896938323975,' #39'3,600'#39', '#39'8,100'#39', 3600, 8100, ' '0.73333335' ',' ''$0.42', 417108,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.8' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.86' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.99' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.83' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.85' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.78' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.91' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' '));' 'criteria.push(new ' 'kpCriterion('\42lightning ' 'storms\042', ' '1.6842896938323975,' #39'12,100'#39', '#39'22,200'#39', 12100, 22200, ' '0.73333335' ',' ''$0.42', 417108,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.66' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.54' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.66' '));' 'criteria.push(new ' 'kpCriterion('rain ' 'storms', ' '1.421982765197754,' #39'6,600'#39', '#39'9,900'#39', 6600, 9900, 0.6' ',' ''$0.32', 324834,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '0' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.97' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.91' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.51' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.64' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.51' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' '));' 'criteria.push(new ' 'kpCriterion('[rain ' 'storms]', ' '1.421982765197754,' #39'1,300'#39', '#39'1,900'#39', 1300, 1900, 0.6' ',' ''$0.32', 324834,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '2' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.53' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.53' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.49' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.71' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.48' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity('

Read the article

Delphi - TPerlRegEx / RegExBuddy Problem

- by Brad

I've got a problem with RegEx and Delphi 2k9 (Win32). I get the following Error: First chance exception at $7C812AFB. Exception class Exception with message 'TPerlRegEx.Compile() - Please specify a regular expression in RegEx first'. I've got the latest version of TPerlRegEx from the website. Using its defualt settings (Using DLL) I'm including demo source code. It's using the code generated by RegExBuddy, latest version. http://www.4shared.com/file/236428923/97478b61/googleresultstestdata.html http://www.4shared.com/file/236439483/e0acbe6d/Unit2.html Delphi FORM http://www.4shared.com/file/236439473/6734a2a2/Unit2.html Delphi PAS Thanks for any help -Brad Data is from Google External Keyword Tool RegEx could use some refinement... but works in RegExBuddy not in Delphi unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, PerlRegEx; type TForm2 = class(TForm) Memo1: TMemo; Memo2: TMemo; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.dfm} procedure TForm2.Button1Click(Sender: TObject); var Regex: TPerlRegEx; GroupIndex: Integer; begin Regex := TPerlRegEx.Create(nil); Regex.RegEx := 'criteria\.push\(new kpCriterion\('(?P<keyword>(.*?))', (?P<number1>(.*?)),'#13#10'''(?P<localsearch>(.*?))'', ''(?P<globalsearch>(.*?))'', (?P<localsearchnum>(.*?)), (?P<globalsearchnum>(.*?)), (.*+)'#13#10','#13#10''\$(?P<price>(.*?))', (?P<number2>(.*?)),'#13#10''(?P<range>(.*?))', (?P<number3>(.*+))'; Regex.Options := [preMultiLine]; Regex.Subject := memo1.text; if Regex.Match then begin memo2.Lines.Add('Matches Found'); repeat for GroupIndex := 0 to Regex.SubExpressionCount do begin memo2.lines.add( Regex.SubExpressions[GroupIndex]); //Add Results to memo // backreference text: Regex.SubExpressions[GroupIndex]; // backreference start: Regex.SubExpressionOffsets[GroupIndex]; // backreference length: Regex.SubExpressionLengths[GroupIndex]; end; until not Regex.MatchAgain; end else memo2.Lines.Add('No-Matches Found'); end; end. DFM object Form2: TForm2 Left = 0 Top = 0 Caption = 'Form2' ClientHeight = 247 ClientWidth = 480 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo Left = 8 Top = 8 Width = 185 Height = 89 Lines.Strings = ( 'var showImpressions = false; var ' 'criteriaSuggestor = ' ''sensei_keyword'; var ' 'historicalTimePeriod = 'Mar ' '2009 - Feb 2010'; var ' 'historicalStartMonth = 2; var ' 'impressionTimePeriod = ' ''February'; var ' 'criteriaGroupsArray = new Array(); ' 'var captchaError = false; var ' 'quotaExceeded = false;' 'var criteria = new Array();' 'var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.4' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' '));' 'criteria.push(new ' 'kpCriterion('thunderstorm&#3' '9;, 1.9117305278778076,' #39'201,000'#39', '#39'550,000'#39', 201000, ' '550000, 0.8666667' ',' ''$0.49', 493102,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.42' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.46' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.36' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' '));' 'criteria.push(new ' 'kpCriterion('[thunderstorm]&' '#39;, 1.9117305278778076,' #39'33,100'#39', '#39'90,500'#39', 33100, 90500, ' '0.8666667' ',' ''$0.49', 493102,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '3' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.43' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.4' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.45' '));' 'criteria.push(new ' 'kpCriterion('\42thunderstorm\' '042', 1.9117305278778076,' #39'201,000'#39', '#39'450,000'#39', 201000, ' '450000, 0.8666667' ',' ''$0.49', 493102,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.64' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.56' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.53' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.58' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' '));' 'criteria.push(new ' 'kpCriterion('thunderstorms&#' '39;, 1.8268921375274658,' #39'110,000'#39', '#39'201,000'#39', 110000, ' '201000, 0.8' ',' ''$0.56', 559074,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.83' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.42' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.41' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.56' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.39' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.5' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.51' '));' 'criteria.push(new ' 'kpCriterion('[thunderstorms]&' '#39;, 1.8268921375274658,' #39'22,200'#39', '#39'40,500'#39', 22200, 40500, ' '0.8' ',' ''$0.56', 559074,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.64' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.56' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.52' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.53' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.47' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.58' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' '));' 'criteria.push(new ' 'kpCriterion('\42thunderstorms' '\042', 1.8268921375274658,' #39'110,000'#39', '#39'165,000'#39', 110000, ' '165000, 0.8' ',' ''$0.56', 559074,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.71' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.92' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' '));' 'criteria.push(new ' 'kpCriterion('lightning ' 'storm', 1.774579644203186,' #39'49,500'#39', '#39'90,500'#39', 49500, 90500, ' '0.73333335' ',' ''$0.54', 535666,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.97' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.98' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.84' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.86' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' '));' 'criteria.push(new ' 'kpCriterion('[lightning ' 'storm]', 1.774579644203186,' #39'12,100'#39', '#39'22,200'#39', 12100, 22200, ' '0.73333335' ',' ''$0.54', 535666,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.72' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.85' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.92' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.67' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.71' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.65' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' '));' 'criteria.push(new ' 'kpCriterion('\42lightning ' 'storm\042', ' '1.774579644203186,' #39'33,100'#39', '#39'60,500'#39', 33100, 60500, ' '0.73333335' ',' ''$0.54', 535666,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '5' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.71' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.66' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.74' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.72' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' '));' 'criteria.push(new ' 'kpCriterion('rain storm', ' '1.7464053630828857,' #39'27,100'#39', '#39'49,500'#39', 27100, 49500, ' '0.6666667' ',' ''$0.53', 526334,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '0' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.55' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.74' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.89' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' '));' 'criteria.push(new ' 'kpCriterion('[rain ' 'storm]', ' '1.7464053630828857,' #39'5,400'#39', '#39'8,100'#39', 5400, 8100, ' '0.6666667' ',' ''$0.53', 526334,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '2' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.68' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.69' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.73' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.72' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.62' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.59' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.66' '));' 'criteria.push(new ' 'kpCriterion('\42rain ' 'storm\042', ' '1.7464053630828857,' #39'14,800'#39', '#39'27,100'#39', 14800, 27100, ' '0.6666667' ',' ''$0.53', 526334,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '0' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.87' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.78' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.84' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.79' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.61' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.92' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.82' '));' 'criteria.push(new ' 'kpCriterion('lightning ' 'storms', ' '1.6842896938323975,' #39'14,800'#39', '#39'27,100'#39', 14800, 27100, ' '0.73333335' ',' ''$0.42', 417108,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_BROAD' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.9' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.9' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.84' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.7' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.88' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.76' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.57' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.75' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.63' '));' 'criteria.push(new ' 'kpCriterion('[lightning ' 'storms]', ' '1.6842896938323975,' #39'3,600'#39', '#39'8,100'#39', 3600, 8100, ' '0.73333335' ',' ''$0.42', 417108,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_EXACT' ',' '0' ')); var monthlyVariation = new ' 'Array();' 'monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.8' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.86' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '1.0' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.99' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.83' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.85' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.78' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.77' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.6' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.91' ')); monthlyVariation.push(new ' 'kpMonthlyPopularity(' '0.81' '));' 'criteria.push(new ' 'kpCriterion('\42lightning ' 'storms\042', ' '1.6842896938323975,' #39'12,100'#39', '#39'22,200'#39', 12100, 22200, ' '0.73333335' ',' ''$0.42', 417108,' ''1 - 3', 2' ',' '0' ',' '0' ',' 'monthlyVariation,' '4' ',' '''' ',' 'kpView.MATCH_PHRASE' ',' '0' ')); var monthlyVariation =

Read the article

Delphi: Minimize application to systray

- by marco92w

I want to minimize a Delphi application to the systray instead of the task bar. The necessary steps seem to be the following: Create icon which should then be displayed in the systray. When the user clicks the [-] to minimize the application, do the following: Hide the form. Add the icon (step #1) to the systray. Hide/delete the application's entry in the task bar. When the user double-clicks the application's icon in the systray, do the following: Show the form. Un-minimize the application again and bring it to the front. If "WindowState" is "WS_Minimized" set to "WS_Normal". Hide/delete the application's icon in the systray. When the user terminates the application, do the following: Hide/delete the application's icon in the systray. That's it. Right? How could one implement this in Delphi? I've found the following code but I don't know why it works. It doesn't follow my steps described above ... unit uMinimizeToTray; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellApi; const WM_NOTIFYICON = WM_USER+333; type TMinimizeToTray = class(TForm) procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure CMClickIcon(var msg: TMessage); message WM_NOTIFYICON; private { Private-Deklarationen } public { Public-Deklarationen } end; var MinimizeToTray: TMinimizeToTray; implementation {$R *.dfm} procedure TMinimizeToTray.CMClickIcon(var msg: TMessage); begin if msg.lparam = WM_LBUTTONDBLCLK then Show; end; procedure TMinimizeToTray.FormCreate(Sender: TObject); VAR tnid: TNotifyIconData; HMainIcon: HICON; begin HMainIcon := LoadIcon(MainInstance, 'MAINICON'); Shell_NotifyIcon(NIM_DELETE, @tnid); tnid.cbSize := sizeof(TNotifyIconData); tnid.Wnd := handle; tnid.uID := 123; tnid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; tnid.uCallbackMessage := WM_NOTIFYICON; tnid.hIcon := HMainIcon; tnid.szTip := 'Tooltip'; Shell_NotifyIcon(NIM_ADD, @tnid); end; procedure TMinimizeToTray.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caNone; Hide; end; end.

Read the article

Exception opening TAdoDataset: Arguments are of the wrong type, are out of acceptable range, or are

- by Dave Falkner

I've been trying to debug the following problem for several weeks now - this method is called from several places within the same datamodule, but this exception (from the subject line of this post) only occurs when integers for a certain purpose (pickup orders vs. orders that we ship through a carrier) are used - and don't ask me how the application can tell the difference between one integer's purpose and another! Furthermore, I cannot duplicate this issue on my machine - the error occurs on a warehouse machine but not my own development machine, even when working with the same production database. I have suspected an MDAC version conflict between the two machines, but have run a version checker and confirmed that both machines are running 2.8, and additionally have confirmed this by logging the TAdoDataset's .Version property at runtime. function TdmESShip.SecondaryID(const PrimaryID : Integer ): String; begin try with qESPackage2 do begin if Active then Close; LogMessage('-----------------------------------'); LogMessage('Version: ' + FConnection.Version); LogMessage('DB Info: ' + FConnection.Properties['Initial Catalog'].Value + ' ' + FConnection.Properties['Data Source'].Value); LogMessage('Setting the parameter.'); Parameters.ParamByName('ParameterName').Value := PrimaryID; LogMessage('Done setting the parameter.'); Open; Ninety-nine times out of 100 this logging code logs a successful operation as follows: Version: 2.8 DB Info: (database name and instance) Setting the parameter. Done setting the parameter. Opened the dataset. But then whenever a "pickup" order is processed, this exception gets thrown whenever the dataset is opened: Version: 2.8 DB Info: (database name and instance) Setting the parameter. Done setting the parameter. GetESPackageID() threw an exception. Type: EOleException, Message: Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another Error: Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another for packageID 10813711 I've tried eliminating the parameter and have built the commandtext for this dataset programmatically, suspecting that some part of the TParameter's configuration might be out of whack, but the same error occurs under the same circumstances. I've tried every combination of TParameter properties that I can think of - this is the millionth TParameter I've created for my millionth dataset, and I've never encountered this error. I've even created a second dataset from scratch and removed all references to the original dataset in case some property of the original dataset in the .dfm might be corrupted, but the same error occurs under the same circumstances. The commandtext for this dataset is a simple select ValueA from TableName where ValueB = @ParameterB I'm about ready to do something extreme, such as writing a web service to look these values up - it feels right now as though I could destroy my machine, rebuild it, rewrite this entire application from scratch, and the application would still know to throw an exception whenever I try to look up a secondary value from a primary value, but only for pickup orders, and only from the one machine in the warehouse, but I'm probably missing something simple. So, any help anyone could provide would be greatly appreciated.

Read the article

How to Pass a JS Variable to a PHP Variable

- by dmullins

Hello: I am working on a web application that currently provides a list of documents in a MySql database. Each document in the list has an onclick event that is suppose to open the specific document, however I am unable to do this. My list gets popluated using Ajax. Here is the code excerpt (JS): function stateChanged() { if (xmlhttp.readyState==4) { //All documents// document.getElementById("screenRef").innerHTML="<font id='maintxt'; name='title'; onclick='fileopen()'; color='#666666';>" + xmlhttp.responseText + "</font>"; } } } The onclick=fileopen event above triggers the next code excerpt, which downloads the file (JS): function stateChanged() { if (xmlhttp.readyState==4) { //Open file var elemIF = document.createElement("iframe"); elemIF.src = url; elemIF.style.display = "none"; document.body.appendChild(elemIF); } } } Lastly, the openfile onclick event triggers the following php code to find the file for downloading (php): $con = mysql_connect("localhost", "root", "password"); if (!$con) { die('Could not connect: ' . mysql_error()); } mysql_select_db("Documents", $con); $query = mysql_query("SELECT name, type, size, content FROM upload WHERE name = NEED JS VARIABLE HERE"); $row = mysql_fetch_array($query); header ("Content-type: ". $row['type']); header ("Content-length: ". $row['size']); header ("Content-Disposition: attachement; filename=". $row['name']); echo $row['content']; This code works well, for downloading a file. If I omit the WHERE portion of the Sql query, the onclick event will download the first file. Somehow, I need to get the screenRef element text and change it into a variable that my php file can read. Does anyone know how to do this? Also, without any page refreshes. I really appreciate everyone's feedback and thank you in advance. DFM

Read the article

LsaAddAccountRights not working for me

- by SteveL

Using: Delphi 2010 and the JEDI Windows API and JWSCL I am trying to assign the Logon As A Service privilege to a user using LsaAddAccountRights function but it does not work ie. after the function returns, checking in Group Policy Editor shows that the user still does not have the above mentioned privilege. I'm running the application on Windows XP. Would be glad if someone could point out what is wrong in my code: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, JwaWindows, JwsclSid; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function AddPrivilegeToAccount(AAccountName, APrivilege: String): DWORD; var lStatus: TNTStatus; lObjectAttributes: TLsaObjectAttributes; lPolicyHandle: TLsaHandle; lPrivilege: TLsaUnicodeString; lSid: PSID; lSidLen: DWORD; lTmpDomain: String; lTmpDomainLen: DWORD; lTmpSidNameUse: TSidNameUse; lPrivilegeWStr: String; begin ZeroMemory(@lObjectAttributes, SizeOf(lObjectAttributes)); lStatus := LsaOpenPolicy(nil, lObjectAttributes, POLICY_LOOKUP_NAMES, lPolicyHandle); if lStatus <> STATUS_SUCCESS then begin Result := LsaNtStatusToWinError(lStatus); Exit; end; try lTmpDomainLen := DNLEN; // In 'clear code' this should be get by LookupAccountName SetLength(lTmpDomain, lTmpDomainLen); lSidLen := SECURITY_MAX_SID_SIZE; GetMem(lSid, lSidLen); try if LookupAccountName(nil, PChar(AAccountName), lSid, lSidLen, PChar(lTmpDomain), lTmpDomainLen, lTmpSidNameUse) then begin lPrivilegeWStr := APrivilege; lPrivilege.Buffer := PChar(lPrivilegeWStr); lPrivilege.Length := Length(lPrivilegeWStr) * SizeOf(Char); lPrivilege.MaximumLength := lPrivilege.Length; lStatus := LsaAddAccountRights(lPolicyHandle, lSid, @lPrivilege, 1); Result := LsaNtStatusToWinError(lStatus); end else Result := GetLastError; finally FreeMem(lSid); end; finally LsaClose(lPolicyHandle); end; end; procedure TForm1.Button1Click(Sender: TObject); begin AddPrivilegeToAccount('Sam', 'SeServiceLogonRight'); end; end. Thanks in advance.

Read the article

Delphi / MySql : Problems escaping strings

- by mawg

N00b here, having problems escaping strings. I used the QuotedStr() function - shouldn't that be enough. Unfortunately, the string that I am trying to quote is rather messy, but I will post it here in case anyone wants to paste it into WinMerge or KDiff3, etc. I am trying to store an entire Delphi form into the database, rather than into a .DFM file. It has only one field, a TEdit edit box. The debugger shows the form as text as 'object Form1: TScriptForm'#$D#$A' Left = 0'#$D#$A' Top = 0'#$D#$A' Align = alClient'#$D#$A' BorderStyle = bsNone'#$D#$A' ClientHeight = 517'#$D#$A' ClientWidth = 993'#$D#$A' Color = clBtnFace'#$D#$A' Font.Charset = DEFAULT_CHARSET'#$D#$A' Font.Color = clWindowText'#$D#$A' Font.Height = -11'#$D#$A' Font.Name = 'MS Sans Serif''#$D#$A' Font.Style = []'#$D#$A' OldCreateOrder = False'#$D#$A' SaveProps.Strings = ('#$D#$A' 'Visible=False')'#$D#$A' PixelsPerInch = 96'#$D#$A' TextHeight = 13'#$D#$A' object Edit1: TEdit'#$D#$A' Left = 192'#$D#$A' Top = 64'#$D#$A' Width = 121'#$D#$A' Height = 21'#$D#$A' TabOrder = 8'#$D#$A' end'#$D#$A'end'#$D#$A before calling QuotedStr() and ''object Form1: TScriptForm'#$D#$A' Left = 0'#$D#$A' Top = 0'#$D#$A' Align = alClient'#$D#$A' BorderStyle = bsNone'#$D#$A' ClientHeight = 517'#$D#$A' ClientWidth = 993'#$D#$A' Color = clBtnFace'#$D#$A' Font.Charset = DEFAULT_CHARSET'#$D#$A' Font.Color = clWindowText'#$D#$A' Font.Height = -11'#$D#$A' Font.Name = ''MS Sans Serif'''#$D#$A' Font.Style = []'#$D#$A' OldCreateOrder = False'#$D#$A' SaveProps.Strings = ('#$D#$A' ''Visible=False'')'#$D#$A' PixelsPerInch = 96'#$D#$A' TextHeight = 13'#$D#$A' object Edit1: TEdit'#$D#$A' Left = 192'#$D#$A' Top = 64'#$D#$A' Width = 121'#$D#$A' Height = 21'#$D#$A' TabOrder = 8'#$D#$A' end'#$D#$A'end'#$D#$A''' afterwards. The strange thing is that my complete command 'INSERT INTO designerFormDfm(designerFormDfmText) VALUES ("'object Form1: TScriptForm'#$D#$A' Left = 0'#$D#$A' Top = 0'#$D#$A' Align = alClient'#$D#$A' BorderStyle = bsNone'#$D#$A' ClientHeight = 517'#$D#$A' ClientWidth = 993'#$D#$A' Color = clBtnFace'#$D#$A' Font.Charset = DEFAULT_CHARSET'#$D#$A' Font.Color = clWindowText'#$D#$A' Font.Height = -11'#$D#$A' Font.Name = ''MS Sans Serif'''#$D#$A' Font.Style = []'#$D#$A' OldCreateOrder = False'#$D#$A' SaveProps.Strings = ('#$D#$A' ''Visible=False'')'#$D#$A' PixelsPerInch = 96'#$D#$A' TextHeight = 13'#$D#$A' object Edit1: TEdit'#$D#$A' Left = 192'#$D#$A' Top = 64'#$D#$A' Width = 121'#$D#$A' Height = 21'#$D#$A' TabOrder = 8'#$D#$A' end'#$D#$A'end'#$D#$A''");' executes in a MySql console, but not from Delphi, where I pass that command as parameter command to a function which ADOCommand.CommandText := command; ADOCommand.CommandType := cmdText; ADOCommand.Execute(); I can only assume that I am having problems escpaing sequences which contain single quotes (and QuotedStr() doesn't seem to escape backslahes(?!)) What am I doing that is obviously, glaringly wrong?

Read the article

Delphi / MySql : Problems escpaing strings

- by mawg

N00b here, having problems escaping strings. I used the QuotedStr() function - shouldn't that be enough. Unfortunately, the string that I am trying to quote is rather messy, but I will post it here in case anyone wants to paste it into WinMerge or KDiff3, etc. I am trying to store an entire Delphi form into the database, rather than into a .DFM file. It has only one field, a TEdit edit box. The debugger shows the form as text as 'object Form1: TScriptForm'#$D#$A' Left = 0'#$D#$A' Top = 0'#$D#$A' Align = alClient'#$D#$A' BorderStyle = bsNone'#$D#$A' ClientHeight = 517'#$D#$A' ClientWidth = 993'#$D#$A' Color = clBtnFace'#$D#$A' Font.Charset = DEFAULT_CHARSET'#$D#$A' Font.Color = clWindowText'#$D#$A' Font.Height = -11'#$D#$A' Font.Name = 'MS Sans Serif''#$D#$A' Font.Style = []'#$D#$A' OldCreateOrder = False'#$D#$A' SaveProps.Strings = ('#$D#$A' 'Visible=False')'#$D#$A' PixelsPerInch = 96'#$D#$A' TextHeight = 13'#$D#$A' object Edit1: TEdit'#$D#$A' Left = 192'#$D#$A' Top = 64'#$D#$A' Width = 121'#$D#$A' Height = 21'#$D#$A' TabOrder = 8'#$D#$A' end'#$D#$A'end'#$D#$A before calling QuotedStr() and ''object Form1: TScriptForm'#$D#$A' Left = 0'#$D#$A' Top = 0'#$D#$A' Align = alClient'#$D#$A' BorderStyle = bsNone'#$D#$A' ClientHeight = 517'#$D#$A' ClientWidth = 993'#$D#$A' Color = clBtnFace'#$D#$A' Font.Charset = DEFAULT_CHARSET'#$D#$A' Font.Color = clWindowText'#$D#$A' Font.Height = -11'#$D#$A' Font.Name = ''MS Sans Serif'''#$D#$A' Font.Style = []'#$D#$A' OldCreateOrder = False'#$D#$A' SaveProps.Strings = ('#$D#$A' ''Visible=False'')'#$D#$A' PixelsPerInch = 96'#$D#$A' TextHeight = 13'#$D#$A' object Edit1: TEdit'#$D#$A' Left = 192'#$D#$A' Top = 64'#$D#$A' Width = 121'#$D#$A' Height = 21'#$D#$A' TabOrder = 8'#$D#$A' end'#$D#$A'end'#$D#$A''' afterwards. The strange thing is that my complete command 'INSERT INTO designerFormDfm(designerFormDfmText) VALUES ("'object Form1: TScriptForm'#$D#$A' Left = 0'#$D#$A' Top = 0'#$D#$A' Align = alClient'#$D#$A' BorderStyle = bsNone'#$D#$A' ClientHeight = 517'#$D#$A' ClientWidth = 993'#$D#$A' Color = clBtnFace'#$D#$A' Font.Charset = DEFAULT_CHARSET'#$D#$A' Font.Color = clWindowText'#$D#$A' Font.Height = -11'#$D#$A' Font.Name = ''MS Sans Serif'''#$D#$A' Font.Style = []'#$D#$A' OldCreateOrder = False'#$D#$A' SaveProps.Strings = ('#$D#$A' ''Visible=False'')'#$D#$A' PixelsPerInch = 96'#$D#$A' TextHeight = 13'#$D#$A' object Edit1: TEdit'#$D#$A' Left = 192'#$D#$A' Top = 64'#$D#$A' Width = 121'#$D#$A' Height = 21'#$D#$A' TabOrder = 8'#$D#$A' end'#$D#$A'end'#$D#$A''");' executes in a MySql console, but not from Delphi, where I pass that command as parameter command to a function which ADOCommand.CommandText := command; ADOCommand.CommandType := cmdText; ADOCommand.Execute(); I can only assume that I am having problems escpaing sequences which contain single quotes (and QuotedStr() doesn't seem to escape backslahes(?!)) What am I doing that is obviously, glaringly wrong?

Read the article

[Delphi] open text files in one application

- by Remus Rigo

hi all I want to write an text editor and to assign the txt files to it. My problem is that I want to have only one instance running and when a new file is opened to send the filename to the first app that is already running... (I want to do this using mutex). Here is a small test DPR looks like this uses Windows, Messages, SysUtils, Forms, wndMain in 'wndMain.pas' {frmMain}; {$R *.res} var PrevWindow : HWND; S : string; CData : TCopyDataStruct; begin PrevWindow := 0; if OpenMutex(MUTEX_ALL_ACCESS, False, 'MyMutex') <> 0 then begin repeat PrevWindow:=FindWindow('TfrmMain', nil); until PrevWindow<>Application.Handle; if IsWindow(PrevWindow) then begin SendMessage(PrevWindow, WM_SYSCOMMAND, SC_RESTORE, 0); BringWindowToTop(PrevWindow); SetForegroundWindow(PrevWindow); if FileExists(ParamStr(1)) then begin S:=ParamStr(1); CData.dwData:=0; CData.lpData:=PChar(S); CData.cbData:=1+Length(S); SendMessage(PrevWindow, WM_COPYDATA, 0, DWORD(@CData) ); end; end; end else CreateMutex(nil, False, 'MyMutex'); Application.Initialize; Application.CreateForm(TfrmMain, frmMain); Application.Run; end. PAS: type TfrmMain = class(TForm) memo: TMemo; private procedure WMCopyData ( var msg : TWMCopyData ) ; message WM_COPYDATA; public procedure OpenFile(f : String); end; var frmMain: TfrmMain; implementation {$R *.dfm} procedure TfrmMain.WMCopyData ( var msg : TWMCopyData ) ; var f : String; begin f:=PChar(msg.CopyDataStruct.lpData); //ShowMessage(f); OpenFile(f); end; procedure TfrmMain.OpenFile(f : String); begin memo.Clear; memo.Lines.LoadFromFile(f); Caption:=f; end; this code should be ok, but if i want to open a text file (from the second app), the first app receives a message like this: thanks

Read the article

Delphi Indy IDHTTP question

- by user327175

I am trying to get the captcha image from a AOL, and i keep getting an error 418. unit imageunit; /// /// h t t p s://new.aol.com/productsweb/ /// interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdIntercept, IdZLibCompressorBase, IdCompressorZLib, IdCookieManager, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,jpeg,GIFImg, ExtCtrls; type TForm2 = class(TForm) IdHTTP1: TIdHTTP; IdCookieManager1: TIdCookieManager; IdCompressorZLib1: TIdCompressorZLib; IdConnectionIntercept1: TIdConnectionIntercept; IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL; Panel1: TPanel; Image1: TImage; Panel2: TPanel; Button1: TButton; Edit1: TEdit; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.dfm} procedure TForm2.Button1Click(Sender: TObject); var JPI : TJPEGImage; streamdata:TMemoryStream; begin streamdata := TMemoryStream.Create; try idhttp1.Get(edit1.Text, Streamdata); Except { Handle exceptions } On E : Exception Do Begin MessageDlg('Exception: '+E.Message,mtError, [mbOK], 0); End; End; //h t t p s://new.aol.com/productsweb/WordVerImage?20890843 //h t t p s://new.aol.com/productsweb/WordVerImage?91868359 /// /// gives error 418 unused /// streamdata.Position := 0; JPI := TJPEGImage.Create; Try JPI.LoadFromStream ( streamdata ); Finally Image1.Picture.Assign ( JPI ); JPI.Free; streamdata.Free; End; end; end. Form: object Form2: TForm2 Left = 0 Top = 0 Caption = 'Form2' ClientHeight = 247 ClientWidth = 480 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 0 Top = 41 Width = 480 Height = 206 Align = alClient TabOrder = 0 ExplicitLeft = -8 ExplicitTop = 206 ExplicitHeight = 41 object Image1: TImage Left = 1 Top = 1 Width = 478 Height = 204 Align = alClient ExplicitLeft = 5 ExplicitTop = 17 ExplicitWidth = 200 ExplicitHeight = 70 end end object Panel2: TPanel Left = 0 Top = 0 Width = 480 Height = 41 Align = alTop TabOrder = 1 ExplicitLeft = 40 ExplicitTop = 32 ExplicitWidth = 185 object Button1: TButton Left = 239 Top = 6 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end object Edit1: TEdit Left = 16 Top = 8 Width = 217 Height = 21 TabOrder = 1 end end object IdHTTP1: TIdHTTP Intercept = IdConnectionIntercept1 IOHandler = IdSSLIOHandlerSocketOpenSSL1 MaxAuthRetries = 100 AllowCookies = True HandleRedirects = True RedirectMaximum = 100 ProxyParams.BasicAuthentication = False ProxyParams.ProxyPort = 0 Request.ContentLength = -1 Request.Accept = 'image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-s' + 'hockwave-flash, application/cade, application/xaml+xml, applicat' + 'ion/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-' + 'application, /' Request.BasicAuthentication = False Request.Referer = 'http://www.yahoo.com' Request.UserAgent = 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.2.1) Gecko/201001' + '22 firefox/3.6.1' HTTPOptions = [hoForceEncodeParams] CookieManager = IdCookieManager1 Compressor = IdCompressorZLib1 Left = 240 Top = 80 end object IdCookieManager1: TIdCookieManager Left = 360 Top = 136 end object IdCompressorZLib1: TIdCompressorZLib Left = 368 Top = 16 end object IdConnectionIntercept1: TIdConnectionIntercept Left = 304 Top = 72 end object IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL Intercept = IdConnectionIntercept1 MaxLineAction = maException Port = 0 DefaultPort = 0 SSLOptions.Mode = sslmUnassigned SSLOptions.VerifyMode = [] SSLOptions.VerifyDepth = 0 Left = 192 Top = 136 end end If you go to: h t t p s://new.aol.com/productsweb/ you will notice the captcha image has a url like: h t t p s://new.aol.com/productsweb/WordVerImage?91868359 I put that url in the edit box and get an error. What is wrong with this code.

Read the article

Programmatically swap colors from a loaded bitmap to Red, Green, Blue or Gray, pixel by pixel.

- by eyeClaxton

Download source code here: http://www.eyeClaxton.com/download/delphi/ColorSwap.zip I would like to take a original bitmap (light blue) and change the colors (Pixel by Pixel) to the red, green, blue and gray equivalence relation. To get an idea of what I mean, I have include the source code and a screen shot. Any help would be greatly appreciated. If more information is needed, please feel free to ask. If you could take a look at the code below, I have three functions that I'm looking for help on. The functions "RGBToRed, RGBToGreen and RGBToRed" I can't seem to come up with the right formulas. unit MainUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TMainFrm = class(TForm) Panel1: TPanel; Label1: TLabel; Panel2: TPanel; Label2: TLabel; Button1: TButton; BeforeImage1: TImage; AfterImage1: TImage; RadioGroup1: TRadioGroup; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var MainFrm: TMainFrm; implementation {$R *.DFM} function RGBToGray(RGBColor: TColor): TColor; var Gray: Byte; begin Gray := Round( (0.90 * GetRValue(RGBColor)) + (0.88 * GetGValue(RGBColor)) + (0.33 * GetBValue(RGBColor))); Result := RGB(Gray, Gray, Gray); end; function RGBToRed(RGBColor: TColor): TColor; var Red: Byte; begin // Not sure of the algorithm for this color Result := RGB(Red, Red, Red); end; function RGBToGreen(RGBColor: TColor): TColor; var Green: Byte; begin // Not sure of the algorithm for this color Result := RGB(Green, Green, Green); end; function RGBToBlue(RGBColor: TColor): TColor; var Blue: Byte; begin // Not sure of the algorithm for this color Result := RGB(Blue, Blue, Blue); end; procedure TMainFrm.FormCreate(Sender: TObject); begin BeforeImage1.Picture.LoadFromFile('Images\RightCenter.bmp'); end; procedure TMainFrm.Button1Click(Sender: TObject); var Bitmap: TBitmap; I, X: Integer; Color: Integer; begin Bitmap := TBitmap.Create; try Bitmap.LoadFromFile('Images\RightCenter.bmp'); for X := 0 to Bitmap.Height do begin for I := 0 to Bitmap.Width do begin Color := ColorToRGB(Bitmap.Canvas.Pixels[I, X]); case Color of $00000000: ; // Skip any Color Here! else case RadioGroup1.ItemIndex of 0: Bitmap.Canvas.Pixels[I, X] := RGBToBlue(Color); 1: Bitmap.Canvas.Pixels[I, X] := RGBToRed(Color); 2: Bitmap.Canvas.Pixels[I, X] := RGBToGreen(Color); 3: Bitmap.Canvas.Pixels[I, X] := RGBToGray(Color); end; end; end; end; AfterImage1.Picture.Graphic := Bitmap; finally Bitmap.Free; end; end; end. Okay, I apologize for not making it clearer. I'm trying to take a bitmap (blue in color) and swap the blue pixels with another color. Like the shots below.

Read the article

How to immediate send mail without prompt confirmation dialog

- by lmengyew

I'm using Delphi XE3 and below is my sample application: unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private function Send(const FromAddr, ToAddr, Subject: String; const AttachFiles: array of string; const MsgBody: String): boolean; end; var Form1: TForm1; implementation uses Winapi.Mapi; {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Send('', '[email protected]', 'test', [], ''); end; function TForm1.Send(const FromAddr, ToAddr, Subject: String; const AttachFiles: array of string; const MsgBody: String): boolean; var Msg: TMapiMessage; lpSender, lpRecipient: TMapiRecipDesc; Attach: array of TMapiFileDesc; SMTP: TFNMapiSendMail; MAPIModule: HModule; i: integer; S: string; begin Result := False; FillChar(Msg, SizeOf(Msg), 0); Msg.lpszSubject := PAnsiChar(UTF8String(Subject)); Msg.lpszNoteText := PAnsiChar(UTF8String(MsgBody)); if FromAddr <> '' then begin lpSender.ulRecipClass := MAPI_ORIG; lpSender.lpszName := PAnsiChar(UTF8String(FromAddr)); lpSender.lpszAddress := PAnsiChar(UTF8String(FromAddr)); lpSender.ulReserved := 0; lpSender.ulEIDSize := 0; lpSender.lpEntryID := Nil; Msg.lpOriginator := @lpSender; end; if ToAddr <> '' then begin lpRecipient.ulRecipClass := MAPI_TO; lpRecipient.lpszName := PAnsiChar(UTF8String(ToAddr)); lpRecipient.lpszAddress := PAnsiChar(UTF8String(ToAddr)); lpRecipient.ulReserved := 0; lpRecipient.ulEIDSize := 0; lpRecipient.lpEntryID := Nil; Msg.nRecipCount := 1; Msg.lpRecips := @lpRecipient; end; SetLength(Attach, Length(AttachFiles)); FillChar(Attach[0], Length(Attach) * SizeOf(TMapiFileDesc), 0); i := 0; for S in AttachFiles do begin Attach[i].nPosition := Cardinal($FFFFFFFF); Attach[i].lpszPathName := PAnsiChar(UTF8String(S)); Inc(i); end; Msg.nFileCount := Length(AttachFiles); if Msg.nFileCount = 0 then Msg.lpFiles := nil else Msg.lpFiles := @Attach[0]; MAPIModule := LoadLibrary(PChar(MAPIDLL)); if MAPIModule <> 0 then begin try @SMTP := GetProcAddress(MAPIModule, 'MAPISendMail'); if @SMTP <> nil then Result := SMTP(0, Application.Handle, Msg, 0, 0) = SUCCESS_SUCCESS; finally FreeLibrary(MAPIModule); end; end; end; end. When i click the Button1, it will prompt the confirmation dialog as print screen. My question is how to immediate send mail without prompt the confirmation dialog? Is this possible to achieve?

Read the article

Delphi Pascal - Using SetFilePointerEx and GetFileSizeEx, Getting Physical Media exact size when reading as a file

- by SuicideClutchX2

I am having trouble understanding how to delcare GetFileSizeEx and SetFilePointerEx in Delphi 2009 so that I can use them since they are not in the RTL or Windows.pas. I was able to compile with the following: function GetFileSizeEx(hFile: THandle; lpFileSizeHigh: Pointer): DWORD; external 'kernel32'; Then using GetFileSizeEx(PD, Pointer(DriveSize)); to get the size. But could not get it to work, the disk handle I am using is valid and I have had no problem reading the data or working under the 2gb mark with the older API's. GetFileSize of course returns 4294967295. I have had greater trouble trying to use SetFilePointerEx with the data types it uses. The overall project needs to read the data from a flash card, which is not a problem at all I can do this. My problem is that I can not find the length or size of the media I will be reading. I have code I have used in the past to do this with media under 2GB. But now that I need to read media over 2GB it is a problem. If you still dont understand I am dumping a card with all data including the boot record, etc. This is the code I would normally use to read from the physical disk to grab say the boot record and dump it to file: SetFilePointer(PD,0,nil,FILE_BEGIN); SetLength(Buffer,512); ReadFile(PD,Buffer[0],512,BytesReturned,nil); I just need to figure out how to find the end of an 8gb card and so on as well as being able to set a file pointer beyond the 2gb barrier. I guess any help in the external declarations as well as understand the values that SetFilePointerEx uses (I do not understand the whole High Low thing) would be of great help. var Form1: TForm1; function GetFileSizeEx(hFile: THandle; var FileSize: Int64): DWORD; stdcall; external 'kernel32'; implementation {$R *.dfm} function GetLD(Drive: Char): Cardinal; var Buffer : String; begin Buffer := Format('\\.\%s:',[Drive]); Result := CreateFile(PChar(Buffer),GENERIC_READ Or GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); If Result = INVALID_HANDLE_VALUE Then begin Result := CreateFile(PChar(Buffer),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); end; end; function GetPD(Drive: Byte): Cardinal; var Buffer : String; begin If Drive = 0 Then begin Result := INVALID_HANDLE_VALUE; Exit; end; Buffer := Format('\\.\PHYSICALDRIVE%d',[Drive]); Result := CreateFile(PChar(Buffer),GENERIC_READ Or GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); If Result = INVALID_HANDLE_VALUE Then begin Result := CreateFile(PChar(Buffer),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); end; end; function GetPhysicalDiskNumber(Drive: Char): Byte; var LD : DWORD; DiskExtents : PVolumeDiskExtents; DiskExtent : TDiskExtent; BytesReturned : Cardinal; begin Result := 0; LD := GetLD(Drive); If LD = INVALID_HANDLE_VALUE Then Exit; Try DiskExtents := AllocMem(Max_Path); DeviceIOControl(LD,IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS,nil,0,DiskExtents,Max_Path,BytesReturned,nil); If DiskExtents^.NumberOfDiskExtents > 0 Then begin DiskExtent := DiskExtents^.Extents[0]; Result := DiskExtent.DiskNumber; end; Finally CloseHandle(LD); end; end; procedure TForm1.Button1Click(Sender: TObject); var PD : DWORD; BytesReturned : Cardinal; Buffer : Array Of Byte; myFile: File; DriveSize: Int64; begin PD := GetPD(GetPhysicalDiskNumber(Edit1.Text[1])); If PD = INVALID_HANDLE_VALUE Then Exit; Try GetFileSizeEx(PD, DriveSize); //SetFilePointer(PD,0,nil,FILE_BEGIN); //etLength(Buffer,512); //ZeroMemory(@Buffer,SizeOf(Buffer)); //ReadFile(PD,Buffer[0],512,BytesReturned,nil); //AssignFile(myFile, 'StickDump.bin'); //ReWrite(myFile, 512); //BlockWrite(myFile, Buffer[0], 1); //CloseFile(myFile); Finally CloseHandle(PD); End; end;

Read the article

delphi idhttp post related question

- by paul

hello All im new to delphi. and also almost new to programming world. i was made some simple post software which using idhttp module. but when execute it , it not correctly working. this simple program is check for my account status. if account login successfully it return some source code which include 'top.location =' in source, and if login failed it return not included 'top.location =' inside account.txt is follow first and third account was alived account but only first account can check, after first account other account can't check i have no idea what wrong with it ph896011 pk1089 fsadfasdf dddddss ph896011 pk1089 following is source of delphi if any one help me much apprecated! unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdCookieManager, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; IdHTTP1: TIdHTTP; Memo1: TMemo; IdCookieManager1: TIdCookieManager; lstAcct: TListBox; result: TLabel; Edit1: TEdit; Timer1: TTimer; procedure Button1Click(Sender: TObject); //procedure FormCreate(Sender: TObject); //procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public AccList: TStringList; IdCookie: TIdCookieManager; CookieList: TList; StartCnt: Integer; InputCnt: Integer; WordList: TStringList; WordNoList: TStringList; WordCntList: TStringList; StartTime: TDateTime; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var i: Integer; //temp: String; lsttemp: TStringList; sl : tstringlist; //userId,userPass: string; begin InputCnt:= 0; WordList := TStringList.Create; CookieList := TList.create; IdCookie := TIdCookieManager.Create(self); if FileExists(ExtractFilePath(Application.ExeName) + 'account.txt') then WordList.LoadFromFile(ExtractFilePath(Application.ExeName) + 'account.txt'); WordNoList:= TStringList.Create; WordCntList := TStringList.Create; lsttemp := TStringList.create; sl :=Tstringlist.Create; try try for i := 0 to WordList.Count -1 do begin ExtractStrings([' '], [' '], pchar(WordList[i]), lsttemp); WordNoList.add(lsttemp[0]); //ShowMessage(lsttemp[0]); WordCntList.add(lsttemp[1]); //ShowMessage(lsttemp[1]); sl.Add('ID='+ lsttemp[0]); sl.add('PWD=' + lsttemp[1]); sl.add('SECCHK=0'); IdHTTP1.HandleRedirects := True; IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded'; memo1.Text:=idhttp1.Post('http://user.buddybuddy.co.kr/Login/Login.asp',sl); if pos('top.location =',Memo1.Text)> 0 then begin application.ProcessMessages; ShowMessage('Alive Acc!'); //result.Caption := 'alive acc' ; sleep(1000); Edit1.Text := 'alive acc'; lsttemp.Clear; Memo1.Text := ''; //memo1.Text := IdHTTP1.Get('https://user.buddybuddy.co.kr/Login/Logout.asp'); Sleep(1000); end; if pos('top.location =', memo1.Text) <> 1 then begin application.ProcessMessages; ShowMessage('bad'); Edit1.Text := 'bad'; //edit1.Text := 'bad'; lsttemp.Clear; memo1.Text := ''; sleep(1000) ; end; Edit1.Text := ''; end; finally lsttemp.free; end; StartCnt := lstAcct.items.Count; StartTime := Now; finally sl.Free; end; end; end.

Read the article

Why can't I fetch an AOL captcha image in my Delphi program?

- by Bill

New demo code: I am trying to get the captcha image from a AOL, and i keep getting an error 418. unit imageunit; /// /// h t t p s://new.aol.com/productsweb/ /// interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdIntercept, IdZLibCompressorBase, IdCompressorZLib, IdCookieManager, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,jpeg,GIFImg, ExtCtrls, PerlRegEx; type TForm2 = class(TForm) IdHTTP1: TIdHTTP; IdCookieManager1: TIdCookieManager; IdCompressorZLib1: TIdCompressorZLib; IdConnectionIntercept1: TIdConnectionIntercept; IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL; Panel1: TPanel; Image1: TImage; Panel2: TPanel; Button1: TButton; PerlRegEx1: TPerlRegEx; Memo1: TMemo; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.dfm} function getaimcaptchaimage(data:string):string; var Regex: TPerlRegEx; ResultString: string; begin Regex := TPerlRegEx.Create(nil); Regex.RegEx := '= 1 then begin ResultString := Regex.SubExpressions[1]; end; result:=Resultstring; end; end; procedure TForm2.Button1Click(Sender: TObject); var JPI : TJPEGImage; streamdata:TMemoryStream; SStream: Tstringstream; website:string; begin streamdata := TMemoryStream.Create; SStream := tstringstream.Create ( '' ); try idhttp1.Get('h t t p s://new.aol.com/productsweb/',SStream); memo1.Text:=UTF8ToWideString ( SStream.DataString ); website:='h t t p s://new.aol.com/productsweb/WordVerImage'+getaimcaptchaimage( UTF8ToWideString ( SStream.DataString )); form2.Caption:=website; idhttp1.Get(website, Streamdata); Except { Handle exceptions } On E : Exception Do Begin MessageDlg('Exception: '+E.Message,mtError, [mbOK], 0); End; End; //h t t p s://new.aol.com/productsweb/WordVerImage?20890843 //h t t p s://new.aol.com/productsweb/WordVerImage?91868359 /// /// gives error 418 unused /// streamdata.Position := 0; JPI := TJPEGImage.Create; Try JPI.LoadFromStream ( streamdata ); Finally Image1.Picture.Assign ( JPI ); JPI.Free; streamdata.Free; End; end; end. Form: object Form2: TForm2 Left = 0 Top = 0 Caption = 'Form2' ClientHeight = 247 ClientWidth = 480 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 0 Top = 41 Width = 480 Height = 206 Align = alClient TabOrder = 0 object Image1: TImage Left = 1 Top = 1 Width = 478 Height = 115 Align = alClient ExplicitLeft = 5 ExplicitTop = 17 ExplicitWidth = 200 ExplicitHeight = 70 end object Memo1: TMemo Left = 1 Top = 116 Width = 478 Height = 89 Align = alBottom TabOrder = 0 ExplicitLeft = 80 ExplicitTop = 152 ExplicitWidth = 185 end end object Panel2: TPanel Left = 0 Top = 0 Width = 480 Height = 41 Align = alTop TabOrder = 1 object Button1: TButton Left = 239 Top = 6 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end end object IdHTTP1: TIdHTTP Intercept = IdConnectionIntercept1 IOHandler = IdSSLIOHandlerSocketOpenSSL1 MaxAuthRetries = 100 AllowCookies = True HandleRedirects = True RedirectMaximum = 100 ProxyParams.BasicAuthentication = False ProxyParams.ProxyPort = 0 Request.ContentLength = -1 Request.Accept = 'image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-s' + 'hockwave-flash, application/cade, application/xaml+xml, applicat' + 'ion/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-' + 'application, */*' Request.BasicAuthentication = False Request.Referer = 'http://www.yahoo.com' Request.UserAgent = 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.2.1) Gecko/201001' + '22 firefox/3.6.1' HTTPOptions = [hoForceEncodeParams] CookieManager = IdCookieManager1 Compressor = IdCompressorZLib1 Left = 40 Top = 160 end object IdCookieManager1: TIdCookieManager Left = 360 Top = 136 end object IdCompressorZLib1: TIdCompressorZLib Left = 408 Top = 56 end object IdConnectionIntercept1: TIdConnectionIntercept Left = 304 Top = 72 end object IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL Intercept = IdConnectionIntercept1 MaxLineAction = maException Port = 0 DefaultPort = 0 SSLOptions.Mode = sslmUnassigned SSLOptions.VerifyMode = [] SSLOptions.VerifyDepth = 0 Left = 192 Top = 136 end object PerlRegEx1: TPerlRegEx Options = [] Left = 120 Top = 56 end end If you go to h t t p s://new.aol.com/productsweb/ you will notice the captcha image has a url like h t t p s://new.aol.com/productsweb/WordVerImage?91868359 I put that url in the edit box and get an error. What is wrong with this code? *take the extra spaces out of the URLs

Read the article

Delphi - Using DeviceIoControl passing IOCTL_DISK_GET_LENGTH_INFO to get flash media physical size (Not Partition)

- by SuicideClutchX2

Alright this is the result of a couple of other questions. It appears I was doing something wrong with the suggestions and at this point have come up with an error when using the suggested API to get the media size. Those new to my problem I am working at the physical disk level, not within the confines of a partition or file system. Here is the pastebin code for the main unit (Delphi 2009) - http://clutchx2.pastebin.com/iMnq8kSx Here is the application source and executable with a form built to output the status of whats going on - http://www.mediafire.com/?js8e6ci8zrjq0de Its probably easier to use the download, unless your just looking for problems within the code. I will also paste the code here. unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TfrmMain = class(TForm) edtDrive: TEdit; lblDrive: TLabel; btnMethod1: TButton; btnMethod2: TButton; lblSpace: TLabel; edtSpace: TEdit; lblFail: TLabel; edtFail: TEdit; lblError: TLabel; edtError: TEdit; procedure btnMethod1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; TDiskExtent = record DiskNumber: Cardinal; StartingOffset: Int64; ExtentLength: Int64; end; DISK_EXTENT = TDiskExtent; PDiskExtent = ^TDiskExtent; TVolumeDiskExtents = record NumberOfDiskExtents: Cardinal; Extents: array[0..0] of TDiskExtent; end; VOLUME_DISK_EXTENTS = TVolumeDiskExtents; PVolumeDiskExtents = ^TVolumeDiskExtents; var frmMain: TfrmMain; const FILE_DEVICE_DISK = $00000007; METHOD_BUFFERED = 0; FILE_ANY_ACCESS = 0; IOCTL_DISK_BASE = FILE_DEVICE_DISK; IOCTL_VOLUME_BASE = DWORD('V'); IOCTL_DISK_GET_LENGTH_INFO = $80070017; IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS = ((IOCTL_VOLUME_BASE shl 16) or (FILE_ANY_ACCESS shl 14) or (0 shl 2) or METHOD_BUFFERED); implementation {$R *.dfm} function GetLD(Drive: Char): Cardinal; var Buffer : String; begin Buffer := Format('\\.\%s:',[Drive]); Result := CreateFile(PChar(Buffer),GENERIC_READ Or GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); If Result = INVALID_HANDLE_VALUE Then begin Result := CreateFile(PChar(Buffer),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); end; end; function GetPD(Drive: Byte): Cardinal; var Buffer : String; begin If Drive = 0 Then begin Result := INVALID_HANDLE_VALUE; Exit; end; Buffer := Format('\\.\PHYSICALDRIVE%d',[Drive]); Result := CreateFile(PChar(Buffer),GENERIC_READ Or GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); If Result = INVALID_HANDLE_VALUE Then begin Result := CreateFile(PChar(Buffer),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); end; end; function GetPhysicalDiskNumber(Drive: Char): Byte; var LD : DWORD; DiskExtents : PVolumeDiskExtents; DiskExtent : TDiskExtent; BytesReturned : Cardinal; begin Result := 0; LD := GetLD(Drive); If LD = INVALID_HANDLE_VALUE Then Exit; Try DiskExtents := AllocMem(Max_Path); DeviceIOControl(LD,IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS,nil,0,DiskExtents,Max_Path,BytesReturned,nil); If DiskExtents^.NumberOfDiskExtents > 0 Then begin DiskExtent := DiskExtents^.Extents[0]; Result := DiskExtent.DiskNumber; end; Finally CloseHandle(LD); end; end; procedure TfrmMain.btnMethod1Click(Sender: TObject); var PD : DWORD; CardSize: Int64; BytesReturned: DWORD; CallSuccess: Boolean; begin PD := GetPD(GetPhysicalDiskNumber(edtDrive.Text[1])); If PD = INVALID_HANDLE_VALUE Then Begin ShowMessage('Invalid Physical Disk Handle'); Exit; End; CallSuccess := DeviceIoControl(PD, IOCTL_DISK_GET_LENGTH_INFO, nil, 0, @CardSize, SizeOf(CardSize), BytesReturned, nil); if not CallSuccess then begin edtError.Text := IntToStr(GetLastError()); edtFail.Text := 'True'; end else edtFail.Text := 'False'; CloseHandle(PD); end; end. I placed a second method button on the form so I can write a different set of code into the app if I feel like it. Only minimal error handling and safeguards are there is nothing that wasn't necessary for debugging this via source. I tried this on a Sony Memory Stick using a PSP as the reader because I cant find the adapter for using a duo in my machine. The target is an MS and half of my users use a PSP for a reader half dont. However this should work fine on SD cards and that is a secondary target for my work as well. I tried this on a usb memory card reader and several SD cards. Now that I have fixed my attempt I get an error returned. 50 ERROR_NOT_SUPPORTED The request is not supported. I have found an application that uses this API as well as alot of related functions for what I am trying todo. I am getting ready to look into it the application is called DriveImage and its source is here - http://sourceforge.net/projects/diskimage/ The only thing I have really noticed from that application is there use of TFileStream and using that to get a handle on the physical disk.

Read the article

Delphi 2009 - Strip non alpha numeric from string

- by Brad

I've got the following code, and need to strip all non alpha numeric characters. It's not working in delphi 2009 ` unit Unit2; //Used information from // http://stackoverflow.com/questions/574603/what-is-the-fastest-way-of-stripping-non-alphanumeric-characters-from-a-string-in interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Type TExplodeArray = Array Of String; TForm2 = class(TForm) Memo1: TMemo; ListBox1: TListBox; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } Function Explode ( Const cSeparator, vString : String ) : TExplodeArray; Function Implode ( Const cSeparator : String; Const cArray : TExplodeArray ) : String; Function StripHTML ( S : String ) : String; function allwords(data:string):integer; end; var Form2: TForm2; allword, allphrase: TExplodeArray; implementation {$R *.dfm} Function TForm2.StripHTML ( S : String ) : String; Var TagBegin, TagEnd, TagLength : Integer; Begin TagBegin := Pos ( '<', S ); // search position of first < While ( TagBegin > 0 ) Do Begin // while there is a < in S TagEnd := Pos ( '>', S ); // find the matching > TagLength := TagEnd - TagBegin + 1; Delete ( S, TagBegin, TagLength ); // delete the tag TagBegin := Pos ( '<', S ); // search for next < End; Result := S; // give the result End; Function TForm2.Implode ( Const cSeparator : String; Const cArray : TExplodeArray ) : String; Var i : Integer; Begin Result := ''; For i := 0 To Length ( cArray ) - 1 Do Begin Result := Result + cSeparator + cArray [i]; End; System.Delete ( Result, 1, Length ( cSeparator ) ); End; Function TForm2.Explode ( Const cSeparator, vString : String ) : TExplodeArray; Var i : Integer; S : String; Begin S := vString; SetLength ( Result, 0 ); i := 0; While Pos ( cSeparator, S ) 0 Do Begin SetLength ( Result, Length ( Result ) + 1 ); Result[i] := Copy ( S, 1, Pos ( cSeparator, S ) - 1 ); Inc ( i ); S := Copy ( S, Pos ( cSeparator, S ) + Length ( cSeparator ), Length ( S ) ); End; SetLength ( Result, Length ( Result ) + 1 ); Result[i] := Copy ( S, 1, Length ( S ) ); End; //Copied from JclStrings function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; var Source, Dest: PChar; begin SetLength(Result, Length(S)); UniqueString(Result); Source := PChar(S); Dest := PChar(Result); while (Source < nil) and (Source^ < #0) do begin if Source^ in Chars then begin Dest^ := Source^; Inc(Dest); end; Inc(Source); end; SetLength(Result, (Longint(Dest) - Longint(PChar(Result))) div SizeOf(AnsiChar)); end; function ReplaceNewlines(const AValue: string): string; var SrcPtr, DestPtr: PChar; begin SrcPtr := PChar(AValue); SetLength(Result, Length(AValue)); DestPtr := PChar(Result); while SrcPtr < {greater than less than} #0 do begin if (SrcPtr[0] = #13) and (SrcPtr[1] = #10) then begin DestPtr[0] := '\'; DestPtr[1] := 't'; Inc(SrcPtr); Inc(DestPtr); end else DestPtr[0] := SrcPtr[0]; Inc(SrcPtr); Inc(DestPtr); end; SetLength(Result, DestPtr - PChar(Result)); end; function StripNonAlphaNumeric(const AValue: string): string; var SrcPtr, DestPtr: PChar; begin SrcPtr := PChar(AValue); SetLength(Result, Length(AValue)); DestPtr := PChar(Result); while SrcPtr < #0 do begin if SrcPtr[0] in ['a'..'z', 'A'..'Z', '0'..'9'] then begin DestPtr[0] := SrcPtr[0]; Inc(DestPtr); end; Inc(SrcPtr); end; SetLength(Result, DestPtr - PChar(Result)); end; function TForm2.allwords(data:string):integer; var i:integer; begin listbox1.Items.add(data); data:= StripHTML ( data ); listbox1.Items.add(data); ////////////////////////////////////////////////////////////// data := StrKeepChars(data, ['A'..'Z', 'a'..'z', '0'..'9']); // Strips out everything data comes back blank in Delphi 2009 ////////////////////////////////////////////////////////////// listbox1.Items.add(data); data := stringreplace(data,' ',' ', [rfReplaceAll, rfIgnoreCase] ); //Replace two spaces with one. listbox1.Items.add(data); allword:= explode(' ',data); { // Converting the following PHP code to Delphi $text = ereg_replace("[^[:alnum:]]", " ", $text); while(strpos($text,' ')!==false) $text = ereg_replace(" ", " ", $text); $text=$string=strtolower($text); $text=explode(" ",$text); return count($text); } for I := 0 to Length(allword) - 1 do listbox1.Items.Add(allword[i]); end; procedure TForm2.Button1Click(Sender: TObject); begin //[^[:alnum:]] allwords(memo1.Text); end; end. ` How else would I go about doing this? Thanks

Read the article

Delphi - Proper way to page though data.

- by Brad

I have a string list (TStrings) that has a couple thousand items in it. I need to process them in groups of 100. I basically want to know what the best way to do the loop is in Delphi. I'm hitting a brick wall when I'm trying to figure it out. Thanks unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm2 = class(TForm) Memo1: TMemo; Memo2: TMemo; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation Uses math; {$R *.dfm} procedure TForm2.Button1Click(Sender: TObject); var I:Integer; pages:Integer; str:string; begin pages:= ceil(memo1.Lines.Count/100) ; memo2.Lines.add('Total Pages: '+inttostr(pages)); memo2.Lines.add('Total Items: '+inttostr(memo1.Lines.Count)); // Should just do in batches of 100 VS entire list for I := 0 to memo1.lines.Count - 1 do begin if str '' then str:= str+#10+ memo1.Lines.Strings[i] else str:= memo1.Lines.Strings[i]; end; //I need to stop here every 100 items, then process the items. memo2.Lines.Add(str); end; end. Example form object Form2: TForm2 Left = 0 Top = 0 Caption = 'Form2' ClientHeight = 245 ClientWidth = 527 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo Left = 16 Top = 8 Width = 209 Height = 175 Lines.Strings = ( '4xlt columbia thunder storm jacket' '5 things about thunder storms' 'a thunder storm with a lot of thunder ' 'and lighting sccreensaver' 'a thunder storm with a lot of thunder ' 'and lighting screensaver with no nag ' 'screens' 'all about thunder storms' 'all about thunderstorms for kids' 'amazing tornado videos and ' 'thunderstorm videos' 'are thunder storms louder in ohio?' 'bad thunder storms' 'bathing in thunder storm' 'best thunderstorm pictures' 'cartoon thunder storms' 'celtic thunder storm' 'central valley thunder storm' 'chicago thunderstorm pictures' 'cool thunderstorm pictures' 'current thunderstorm warnings' 'does thunder storms in december mean ' 'snow will be coming' 'facts about thunderstorms for kids' 'facts on thunderstorms for kids' 'fedex thunderstorm video' 'florida thunderstorms facts' 'free relaxing thunderstorm music' 'free soothing thunderstorm sounds ' 'online' 'free thunderstorm mp3' 'free thunderstorm mp3 download' 'free thunderstorm mp3 downloads' 'free thunderstorm mp3s' 'free thunderstorm music' 'free thunderstorm pictures' 'free thunderstorm sound effects' 'free thunderstorm sounds' 'free thunderstorm sounds cd' 'free thunderstorm sounds mp3' 'free thunderstorm sounds online' 'free thunderstorm soundscape' 'free thunderstorm video' 'free thunderstorm video download' 'free thunderstorm videos' 'god of storm and thunder' 'horses storm thunder rain' 'how do thunder storms form' 'how far away is a thunder storm' 'how long do thunder storms last' 'ice cube in a thunder storm' 'indoor thunderstorm safety tips' 'information about thunderstorms for kids' 'interesting thunderstorm facts' 'is it dangerous to shower during thunder ' 'storm' 'is there frequently thunder during snow ' 'storms' 'isolated thunderstorms' 'it'#39's just a thunder storm baby there is ' 'nothing you should fear lyrics' 'lightning & thunder storm safety' 'lightning and thunderstorm facts' 'lightning and thunderstorms facts' 'lightning and thunderstorms for kids' 'listen to thunderstorm sounds online' 'mississauga thunder storm' 'nature sounds free mp3 thunder storm' 'only about thunderstorms facts' 'original storm deep thunderstick' 'phone use during thunder storms' 'pictures of thunderstorms' 'pocono thunder storm' 'posters of thunder storms' 'power rangers ninja storm' 'power rangers thunder storm' 'power rangers thunder storm cast' 'power rangers thunder storm games' 'power rangers thunder storm morphers' 'power rangers thunder storm part 1' 'power rangers thunder storm part 2' 'power rangers thunderstorm' 'power rangers thunderstorm cannon' 'power rangers thunderstorm deluxe ' 'megazord' 'power rangers thunderstorm games' 'power rangers thunderstorm megazord' 'power rangers thunderstorm part 2' 'power rangers thunderstorm pictures' 'power rnager ninja storm thunder staff' 'powerful thunder and lightning storms' 'precambrian thunder storms' 'rain thunderstorm mp3' 'rain thunderstorm pictures' 'relaxing thunderstorm music' 'reminds me of ohio river thunder lighten ' 'storms' 'sacramento thunder storm' 'safety tips for when your caught in a ' 'thunder storm' 'scattered thunderstorms' 'schemer puts his head in the thunder ' 'storm' 'sedative thunder storm' 'server thunder storms' 'severe supercell thunderstorm pictures' 'severe thunder storm pictures' 'severe thunder storms' 'severe thunderstorm facts' 'severe thunderstorm pictures' 'severe thunderstorm pictures hail' 'severe thunderstorm pictures in alberta' 'severe thunderstorm pictures tornado' 'severe thunderstorm safety' 'severe thunderstorm safety tips' 'severe thunderstorm videos' 'severe thunderstorm warning' 'severe thunderstorm warning los ' 'angeles' 'severe thunderstorm warning signs' 'severe thunderstorm warnings' 'severe thunderstorms' 'severe thunderstorms facts' 'shakespeare use thunder storm for ' 'cosmic disorder julius caesar' 'soothing thunderstorm sounds online' 'sound effects of severe thunder storm' 'sound of rain storm finger snapping ' 'thunder chorus' 'split thunder storm' 'storm 3d thunder power' 'storm dark thunder' 'storm dark thunder bowling ball' 'storm dark thunder bowling ball sale' 'storm dark thunder for sale' 'storm dark thunder pearl' 'storm dark thunder pearl bowling ball' 'storm dark thunder review' 'storm dark thunder shirt' 'storm dark thunderball' 'storm deep thunder' 'storm deep thunder 11' 'storm deep thunder 15' 'storm deep thunder 15 lure' 'storm deep thunder 2' 'storm deep thunder lures' 'storm deep thunderstick' 'storm deep thunderstick crankbaits' 'storm deep thunderstick dts09' 'storm deep thunderstick jr' 'storm deep thunderstick lures' 'storm deep thundersticks' 'storm rolling thunder 3 ball roller' 'storm rolling thunder bowling bag' 'storm rolling thunder three ball bowling ' 'bag' 'storm shallow thunder' 'storm shallow thunder 15' 'storm thunder claw' 'storm thunder craw' 'storm watches thunder' 'storms with constant lightning and ' 'thunder non-stop' 'supercell thunder storms' 'supercell thunderstorm pictures' 'supercell thunderstorms' 'swimming pools thunder storms' 'tampa + lightning strikes + thunder ' 'storms' 'texas thunderstorm pictures' 'texas thunderstorm warnings' 'thunder and lightning storm' 'thunder and lighting storms' 'thunder and lightning storms' 'thunder bay snow storm video' 'thunder storm' 'thunder storm and windmill' 'thunder storm cd' 'thunder storm cloud' 'thunder storm clouds' 'thunder storm dog peppermint oil' 'thunder storm in winter' 'thunder storm in winter and weather ' 'prediction' 'thunder storm lx-3 & road blaster psx ' 'download' 'thunder storm occurances' 'thunder storm photos' 'thunder storm poems' 'thunder storm safety' 'thunder storm sign' 'thunder storm sounds' 'thunder storms' 'thunder storms and deaths' 'thunder storms and ilghting' 'thunder storms and lighting' 'thunder storms cd' 'thunder storms in the arctic arctic ' 'weather' 'thunder storms in winter' 'thunder storms on you tub' 'thunder storms pics' 'thunder storms with rain' 'thunderstorm' 'thunderstorm backgrounds' 'thunderstorm capital' 'thunderstorm capital 2008 dorfman' 'thunderstorm capital in boston' 'thunderstorm capital llc' 'thunderstorm capital of canada' 'thunderstorm capital of the us' 'thunderstorm capital of the world' 'thunderstorm facts' 'thunderstorm facts for kids' 'thunderstorm facts hail' 'thunderstorm facts tornadoes' 'thunderstorm mp3' 'thunderstorm mp3 download' 'thunderstorm mp3 download free' 'thunderstorm mp3 downloads' 'thunderstorm mp3 downloads free' 'thunderstorm mp3 files' 'thunderstorm mp3 free' 'thunderstorm mp3 free download' 'thunderstorm mp3 free downloads' 'thunderstorm mp3 torrent' 'thunderstorm mp3s' 'thunderstorm music' 'thunderstorm music cd' 'thunderstorm music downloads' 'thunderstorm music free' 'thunderstorm music playlists' 'thunderstorm music rain' 'thunderstorm pics' 'thunderstorm pictures' 'thunderstorm pictures for kids' 'thunderstorm safety' 'thunderstorm safety for kids' 'thunderstorm safety precautions' 'thunderstorm safety procedures' 'thunderstorm safety rules' 'thunderstorm safety tips' 'thunderstorm safety tips for kids' 'thunderstorm safety tips shelter' 'thunderstorm safety tips trees' 'thunderstorm sound effects' 'thunderstorm sound effects cd' 'thunderstorm sound effects download' 'thunderstorm sound effects free' 'thunderstorm sound effects free ' 'download' 'thunderstorm sound effects free music ' 'feature audio' 'thunderstorm sound effects mp3' 'thunderstorm sound effects rain' 'thunderstorm sounds' 'thunderstorm sounds cd' 'thunderstorm sounds download' 'thunderstorm sounds for sleep' 'thunderstorm sounds for sleeping' 'thunderstorm sounds free' 'thunderstorm sounds free download' 'thunderstorm sounds free downloads' 'thunderstorm sounds mp3' 'thunderstorm sounds mp3 download' 'thunderstorm sounds mp3 free' 'thunderstorm sounds online' 'thunderstorm sounds online for free' 'thunderstorm sounds online free' 'thunderstorm sounds sleep' 'thunderstorm sounds streaming' 'thunderstorm sounds torrent' 'thunderstorm soundscape' 'thunderstorm soundscapes' 'thunderstorm video' 'thunderstorm video clips' 'thunderstorm video download' 'thunderstorm video downloads' 'thunderstorm videos' 'thunderstorm videos for kids' 'thunderstorm videos lightning' 'thunderstorm videos online' 'thunderstorm wallpaper' 'thunderstorm warning' 'thunderstorm warning brisbane' 'thunderstorm warning definition' 'thunderstorm warning los angeles' 'thunderstorm warning san diego' 'thunderstorm warning san mateo county' 'thunderstorm warning santa barbara' 'thunderstorm warning santa clara' 'thunderstorm warning santa clara ' 'county' 'thunderstorm warning signal' 'thunderstorm warning signs' 'thunderstorm warning vs watch' 'thunderstorm warnings' 'thunderstorm warnings and watches' 'thunderstorm warnings for nj' 'thunderstorm warnings qld' 'thunderstorms' 'thunderstorms facts' 'thunderstorms facts for kids' 'thunderstorms for kids' 'tornados and thunder storms animated' 'understanding thunderstorms for kids' 'watch thunderstorm videos' 'weather underground forecast ' 'thunderstorms' 'what causes thunder storms' 'what is a thunder storm' 'where d thunder storms occur') TabOrder = 0 end object Memo2: TMemo Left = 240 Top = 8 Width = 265 Height = 129 Lines.Strings = ( 'Memo2') TabOrder = 1 end object Button1: TButton Left = 384 Top = 184 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 2 OnClick = Button1Click end end

Read the article

Delphi Editbox causing unexplainable errors...

- by NeoNMD

On a form I have 8 edit boxes that I do the exact same thing with. They are arranged in 2 sets of 4, one is Upper and the other is Lower. I kept getting errors clearing all the edit boxes so I went through clearing them 1 by 1 and found that 1 of the edit boxes just didnt work and when I tried to run the program and change that exit box it caused the debugger to jump to a point in the code with the database (even though the edit boxes had nothing to do with the database and they arent in a procedure or stack with a database in it) and say the program has access violation there. So I then removed all mention of that edit box and the code worked perfectly again, so I deleted that edit box, copied and pasted another edit box and left all values the same, then went through my code and copied the code from the other sections and simply renamed it for the new Edit box and it STILL causes an error even though it is entirely new. I cannot figure it out so I ask you all, what the hell? The editbox in question is "Edit1" unit DefinitionCoreV2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, SQLiteTable3, StdCtrls; type TDefinitionFrm = class(TForm) GrpCompetition: TGroupBox; CmbCompSele: TComboBox; BtnCompetitionAdd: TButton; BtnCompetitionUpdate: TButton; BtnCompetitionRevert: TButton; GrpCompetitionDetails: TGroupBox; LblCompetitionIDTitle: TLabel; EdtCompID: TEdit; LblCompetitionDescriptionTitle: TLabel; EdtCompDesc: TEdit; LblCompetitionNotesTitle: TLabel; EdtCompNote: TEdit; LblCompetitionLocationTitle: TLabel; EdtCompLoca: TEdit; BtnCompetitionDelete: TButton; GrpSection: TGroupBox; LblSectionID: TLabel; LblGender: TLabel; LblAge: TLabel; LblLevel: TLabel; LblWeight: TLabel; LblType: TLabel; LblHeight: TLabel; LblCompetitionID: TLabel; BtnSectionAdd: TButton; EdtSectionID: TEdit; CmbGender: TComboBox; BtnSectionUpdate: TButton; BtnSectionRevert: TButton; CmbAgeRange: TComboBox; CmbLevelRange: TComboBox; CmbType: TComboBox; CmbWeightRange: TComboBox; CmbHeightRange: TComboBox; EdtSectCompetitionID: TEdit; BtnSectionDelete: TButton; GrpSectionDetails: TGroupBox; EdtLowerAge: TEdit; EdtLowerWeight: TEdit; EdtLowerHeight: TEdit; EdtUpperAge: TEdit; EdtUpperLevel: TEdit; EdtUpperWeight: TEdit; EdtUpperHeight: TEdit; LblAgeRule: TLabel; LblLevelRule: TLabel; LblWeightRule: TLabel; LblHeightRule: TLabel; LblCompetitionSelect: TLabel; LblSectionSelect: TLabel; CmbSectSele: TComboBox; Edit1: TEdit; procedure FormCreate(Sender: TObject); procedure BtnCompetitionAddClick(Sender: TObject); procedure CmbCompSeleChange(Sender: TObject); procedure BtnCompetitionUpdateClick(Sender: TObject); procedure BtnCompetitionRevertClick(Sender: TObject); procedure BtnCompetitionDeleteClick(Sender: TObject); procedure CmbSectSeleChange(Sender: TObject); procedure BtnSectionAddClick(Sender: TObject); procedure BtnSectionUpdateClick(Sender: TObject); procedure BtnSectionRevertClick(Sender: TObject); procedure BtnSectionDeleteClick(Sender: TObject); procedure CmbAgeRangeChange(Sender: TObject); procedure CmbLevelRangeChange(Sender: TObject); procedure CmbWeightRangeChange(Sender: TObject); procedure CmbHeightRangeChange(Sender: TObject); private procedure UpdateCmbCompSele; procedure AddComp; procedure RevertComp; procedure AddSect; procedure RevertSect; procedure UpdateCmbSectSele; procedure ClearSect; { Private declarations } public { Public declarations } end; var DefinitionFrm: TDefinitionFrm; implementation {$R *.dfm} procedure TDefinitionFrm.UpdateCmbCompSele; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; sCompTitle : string; bNext : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM CompetitionTable'); try CmbCompSele.Items.Clear; Repeat begin sCompTitle:=sltb.FieldAsString(sltb.FieldIndex['CompetitionID'])+':'+sltb.FieldAsString(sltb.FieldIndex['Description']); CmbCompSele.Items.Add(sCompTitle); bNext := sltb.Next; end; Until sltb.EOF; finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.UpdateCmbSectSele; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; sSQL : string; sSectTitle : string; bNext : boolean; bLast : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE CompetitionID = '+EdtCompID.text); If sltb.RowCount =0 then begin sltb := slDb.GetTable('SELECT * FROM SectionTable'); bLast:= sltb.MoveLast; sSQL := 'INSERT INTO SectionTable(SectionID,CompetitionID,Gender,Type) VALUES ('+IntToStr(sltb.FieldAsInteger(sltb.FieldIndex['SectionID'])+1)+','+EdtCompID.text+',1,1)'; sldb.ExecSQL(sSQL); sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE CompetitionID = '+EdtCompID.text); end; try CmbSectSele.Items.Clear; Repeat begin sSectTitle:=sltb.FieldAsString(sltb.FieldIndex['SectionID'])+':'+sltb.FieldAsString(sltb.FieldIndex['Type'])+':'+sltb.FieldAsString(sltb.FieldIndex['Gender'])+':'+sltb.FieldAsString(sltb.FieldIndex['Age'])+':'+sltb.FieldAsString(sltb.FieldIndex['Level'])+':'+sltb.FieldAsString(sltb.FieldIndex['Weight'])+':'+sltb.FieldAsString(sltb.FieldIndex['Height']); CmbSectSele.Items.Add(sSectTitle); //CmbType.Items.Strings[sltb.FieldAsInteger(sltb.FieldIndex['Type'])] Works but has logic errors bNext := sltb.Next; end; Until sltb.EOF; finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.AddComp; var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; bLast : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM CompetitionTable'); try bLast:= sltb.MoveLast; sSQL := 'INSERT INTO CompetitionTable(CompetitionID,Description) VALUES ('+IntToStr(sltb.FieldAsInteger(sltb.FieldIndex['CompetitionID'])+1)+',"New Competition")'; sldb.ExecSQL(sSQL); finally sltb.Free; end; finally sldb.Free; end; UpdateCmbCompSele; end; procedure TDefinitionFrm.AddSect; var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; bLast : boolean; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sltb := slDb.GetTable('SELECT * FROM SectionTable'); try bLast:= sltb.MoveLast; sSQL := 'INSERT INTO SectionTable(SectionID,CompetitionID,Gender,Type) VALUES ('+IntToStr(sltb.FieldAsInteger(sltb.FieldIndex['SectionID'])+1)+','+EdtCompID.text+',1,1)'; sldb.ExecSQL(sSQL); finally sltb.Free; end; finally sldb.Free; end; UpdateCmbSectSele; end; procedure TDefinitionFrm.RevertComp; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; iID : integer; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try If CmbCompSele.Text <> '' then begin iID := StrToInt(Copy(CmbCompSele.Text,0,Pos(':',CmbCompSele.Text)-1)); sltb := slDb.GetTable('SELECT * FROM CompetitionTable WHERE CompetitionID='+IntToStr(iID))//ItemIndex starts at 0, CompID at 1 end else sltb := slDb.GetTable('SELECT * FROM CompetitionTable WHERE CompetitionID=1'); try EdtCompID.Text:=sltb.FieldAsString(sltb.FieldIndex['CompetitionID']); EdtCompLoca.Text:=sltb.FieldAsString(sltb.FieldIndex['Location']); EdtCompDesc.Text:=sltb.FieldAsString(sltb.FieldIndex['Description']); EdtCompNote.Text:=sltb.FieldAsString(sltb.FieldIndex['Notes']); finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.RevertSect; var slDBpath: string; sldb : TSQLiteDatabase; sltb : TSQLiteTable; iID : integer; sTemp : string; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try If CmbCompSele.Text <> '' then begin iID := StrToInt(Copy(CmbSectSele.Text,0,Pos(':',CmbSectSele.Text)-1)); sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE SectionID='+IntToStr(iID));//ItemIndex starts at 0, CompID at 1 end else sltb := slDb.GetTable('SELECT * FROM SectionTable WHERE CompetitionID='+EdtCompID.Text); try EdtSectionID.Text:=sltb.FieldAsString(sltb.FieldIndex['SectionID']); EdtSectCompetitionID.Text:=sltb.FieldAsString(sltb.FieldIndex['CompetitionID']); Case sltb.FieldAsInteger(sltb.FieldIndex['Type']) of 1 : CmbType.ItemIndex:=0; 2 : CmbType.ItemIndex:=0; 3 : CmbType.ItemIndex:=1; 4 : CmbType.ItemIndex:=1; end; Case sltb.FieldAsInteger(sltb.FieldIndex['Gender']) of 1 : CmbGender.ItemIndex:=0; 2 : CmbGender.ItemIndex:=1; 3 : CmbGender.ItemIndex:=2; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Age']); if sTemp <> '' then begin //Decode end else begin LblAgeRule.Hide; EdtLowerAge.Text :=''; EdtLowerAge.Hide; EdtUpperAge.Text :=''; EdtUpperAge.Hide; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Level']); if sTemp <> '' then begin //Decode end else begin LblLevelRule.Hide; Edit1.Text :=''; Edit1.Hide; EdtUpperLevel.Text :=''; EdtUpperLevel.Hide; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Weight']); if sTemp <> '' then begin //Decode end else begin LblWeightRule.Hide; EdtLowerWeight.Text :=''; EdtLowerWeight.Hide; EdtUpperWeight.Text :=''; EdtUpperWeight.Hide; end; sTemp := sltb.FieldAsString(sltb.FieldIndex['Height']); if sTemp <> '' then begin //Decode end else begin LblHeightRule.Hide; EdtLowerHeight.Text :=''; EdtLowerHeight.Hide; EdtUpperHeight.Text :=''; EdtUpperHeight.Hide; end; finally sltb.Free; end; finally sldb.Free; end; end; procedure TDefinitionFrm.BtnCompetitionAddClick(Sender: TObject); begin AddComp end; procedure TDefinitionFrm.ClearSect; begin CmbSectSele.Clear; EdtSectionID.Text:=''; EdtSectCompetitionID.Text:=''; CmbType.Clear; CmbGender.Clear; CmbAgeRange.Clear; EdtLowerAge.Text:=''; EdtUpperAge.Text:=''; CmbLevelRange.Clear; Edit1.Text:=''; EdtUpperLevel.Text:=''; CmbWeightRange.Clear; EdtLowerWeight.Text:=''; EdtUpperWeight.Text:=''; CmbHeightRange.Clear; EdtLowerHeight.Text:=''; EdtUpperHeight.Text:=''; end; procedure TDefinitionFrm.CmbCompSeleChange(Sender: TObject); begin If CmbCompSele.ItemIndex <> -1 then begin RevertComp; GrpSection.Enabled:=True; CmbSectSele.Clear; ClearSect; UpdateCmbSectSele; end; end; procedure TDefinitionFrm.BtnCompetitionUpdateClick(Sender: TObject); var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sSQL:= 'UPDATE CompetitionTable SET Description="'+EdtCompDesc.Text+'",Location="'+EdtCompLoca.Text+'",Notes="'+EdtCompNote.Text+'" WHERE CompetitionID ="'+EdtCompID.Text+'";'; sldb.ExecSQL(sSQL); finally sldb.Free; end; end; procedure TDefinitionFrm.BtnCompetitionRevertClick(Sender: TObject); begin RevertComp; end; procedure TDefinitionFrm.BtnCompetitionDeleteClick(Sender: TObject); var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; iID : integer; begin If CmbCompSele.Text <> '' then begin If (CmbCompSele.Text[1] ='1') and (CmbCompSele.Text[2] =':') then begin MessageDlg('Deleting the last record is a very bad idea :/',mtInformation,[mbOK],0); end else begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try iID := StrToInt(Copy(CmbCompSele.Text,0,Pos(':',CmbCompSele.Text)-1)); sSQL:= 'DELETE FROM SectionTable WHERE CompetitionID='+IntToStr(iID)+';'; sldb.ExecSQL(sSQL); sSQL:= 'DELETE FROM CompetitionTable WHERE CompetitionID='+IntToStr(iID)+';'; sldb.ExecSQL(sSQL); finally sldb.Free; end; CmbCompSele.ItemIndex:=0; UpdateCmbCompSele; RevertComp; CmbCompSele.Text:='Select Competition'; end; end; end; procedure TDefinitionFrm.FormCreate(Sender: TObject); begin UpdateCmbCompSele; end; procedure TDefinitionFrm.CmbSectSeleChange(Sender: TObject); begin RevertSect; end; procedure TDefinitionFrm.BtnSectionAddClick(Sender: TObject); begin AddSect; end; procedure TDefinitionFrm.BtnSectionUpdateClick(Sender: TObject); //change fields values var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; iTypeCode : integer; iGenderCode : integer; sAgeStr, sLevelStr, sWeightStr, sHeightStr : string; begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try If CmbType.Text='Fighting' then iTypeCode := 1 else iTypeCode := 3; If CmbGender.Text='Male' then iGenderCode := 1 else if CmbGender.Text='Female' then iGenderCode := 2 else iGenderCode := 3; Case CmbAgeRange.ItemIndex of 0:sAgeStr := 'o-'+EdtLowerAge.Text; 1:sAgeStr := 'u-'+EdtLowerAge.Text; 2:sAgeStr := EdtLowerAge.Text+'-'+EdtUpperAge.Text; end; Case CmbLevelRange.ItemIndex of 0:sLevelStr := 'o-'+Edit1.Text; 1:sLevelStr := 'u-'+Edit1.Text; 2:sLevelStr := Edit1.Text+'-'+EdtUpperLevel.Text; end; Case CmbWeightRange.ItemIndex of 0:sWeightStr := 'o-'+EdtLowerWeight.Text; 1:sWeightStr := 'u-'+EdtLowerWeight.Text; 2:sWeightStr := EdtLowerWeight.Text+'-'+EdtUpperWeight.Text; end; Case CmbHeightRange.ItemIndex of 0:sHeightStr := 'o-'+EdtLowerHeight.Text; 1:sHeightStr := 'u-'+EdtLowerHeight.Text; 2:sHeightStr := EdtLowerHeight.Text+'-'+EdtUpperHeight.Text; end; sSQL:= 'UPDATE SectionTable SET Type="'+IntToStr(iTypeCode)+'",Gender="'+IntToStr(iGenderCode)+'" WHERE SectionID ="'+EdtSectionID.Text+'";'; sldb.ExecSQL(sSQL); finally sldb.Free; end; end; procedure TDefinitionFrm.BtnSectionRevertClick(Sender: TObject); begin RevertSect; end; procedure TDefinitionFrm.BtnSectionDeleteClick(Sender: TObject); var slDBpath: string; sSQL : string; sldb : TSQLiteDatabase; begin If CmbSectSele.Text[1] ='1' then begin MessageDlg('Deleting the last record is a very bad idea :/',mtInformation,[mbOK],0); end else begin slDBPath := ExtractFilepath(application.exename)+ 'Competitions.db'; if not FileExists(slDBPath) then begin MessageDlg('Competitions.db does not exist.',mtInformation,[mbOK],0); exit; end; sldb := TSQLiteDatabase.Create(slDBPath); try sSQL:= 'DELETE FROM SectionTable WHERE SectionID='+CmbSectSele.Text[1]+';'; sldb.ExecSQL(sSQL); finally sldb.Free; end; CmbSectSele.ItemIndex:=0; UpdateCmbSectSele; RevertSect; CmbSectSele.Text:='Select Competition'; end; end; procedure TDefinitionFrm.CmbAgeRangeChange(Sender: TObject); begin Case CmbAgeRange.ItemIndex of 0: begin EdtLowerAge.Show; LblAgeRule.Caption:='Over and including'; LblAgeRule.Show; EdtUpperAge.Hide; end; 1: begin EdtLowerAge.Show; LblAgeRule.Caption:='Under and including'; LblAgeRule.Show; EdtUpperAge.Hide; end; 2: begin EdtLowerAge.Show; LblAgeRule.Caption:='LblAgeRule'; LblAgeRule.Hide; EdtUpperAge.Show; end; end; end; procedure TDefinitionFrm.CmbLevelRangeChange(Sender: TObject); begin Case CmbLevelRange.ItemIndex of 0: begin Edit1.Show; LblLevelRule.Caption:='Over and including'; LblLevelRule.Show; EdtUpperLevel.Hide; end; 1: begin Edit1.Show; LblLevelRule.Caption:='Under and including'; LblLevelRule.Show; EdtUpperLevel.Hide; end; 2: begin Edit1.Show; LblLevelRule.Caption:='LblLevelRule'; LblLevelRule.Hide; EdtUpperLevel.Show; end; end; end; procedure TDefinitionFrm.CmbWeightRangeChange(Sender: TObject); begin Case CmbWeightRange.ItemIndex of 0: begin EdtLowerWeight.Show; LblWeightRule.Caption:='Over and including'; LblWeightRule.Show; EdtUpperWeight.Hide; end; 1: begin EdtLowerWeight.Show; LblWeightRule.Caption:='Under and including'; LblWeightRule.Show; EdtUpperWeight.Hide; end; 2: begin EdtLowerWeight.Show; LblWeightRule.Caption:='LblWeightRule'; LblWeightRule.Hide; EdtUpperWeight.Show; end; end; end; procedure TDefinitionFrm.CmbHeightRangeChange(Sender: TObject); begin Case CmbHeightRange.ItemIndex of 0: begin EdtLowerHeight.Show; LblHeightRule.Caption:='Over and including'; LblHeightRule.Show; EdtUpperHeight.Hide; end; 1: begin EdtLowerHeight.Show; LblHeightRule.Caption:='Under and including'; LblHeightRule.Show; EdtUpperHeight.Hide; end; 2: begin EdtLowerHeight.Show; LblHeightRule.Caption:='LblHeightRule'; LblHeightRule.Hide; EdtUpperHeight.Show; end; end; end; end.

Search Results

Search found 47 results on 2 pages for 'dfm'.

Page 2/2 | < Previous Page | 1 2

- by omair iqbal

- by lyborko

- by Hamidm

- by Brad

- by Brad

- by marco92w

- by Dave Falkner

- by dmullins

- by SteveL

- by mawg

- by mawg

- by Remus Rigo

- by user327175

- by eyeClaxton

- by lmengyew

- by SuicideClutchX2

- by paul

- by Bill

- by SuicideClutchX2

- by Brad

- by Brad

- by NeoNMD

< Previous Page | 1 2