https://wiki.freepascal.org/api.php?action=feedcontributions&user=Rvk&feedformat=atomFree Pascal wiki - User contributions [en]2024-03-29T10:20:35ZUser contributionsMediaWiki 1.35.6https://wiki.freepascal.org/index.php?title=TMainMenu&diff=111038TMainMenu2017-07-19T13:36:55Z<p>Rvk: </p>
<hr />
<div>{{TMainMenu}}<br />
<br />
A '''TMainMenu''' [[image:tmainmenu.png]] is a non-visual component from the [[Standard tab]] of the [[Component Palette]] that provides a main menu on a form.<br />
<br />
==Description==<br />
The main menu that appears at the top of most windows that form designers can customize by choosing various menu items.<br />
<br />
To see the Menu Editor, right-click on the Main Menu icon on your form.<br />
<br />
==Conventions==<br />
It is common practice to name menus starting with ''mnu'' or ''menu'' and the name of the menu. Submenus continue this by prefixing with the menu they are within, e.g. the 'Cut' submenu in the Edit top-level menu is usually named ''mnuEditCut'' or ''menuEditCut''. This is a mnemonic and makes it easier to remember, six months from now when you need to make changes, how to put them in. Note that this is a ''convention'', it isn't mandatory, but if you do it this way it will probably make it easier to make changes later, or to understand what the code is doing when you haven't been looking at it for a while, or to allow someone else who has to do maintenance on the program you're writing to be able to fix it later.<br />
<br />
Let's get started.<br />
<br />
==Creating Menus==<br />
# Select TMainMenu from the component bar and place a component on your form by clicking on the TMainMenu component, then click on the form but do not let go of the mouse button, and while holding the mouse button down, draw a box and let go of the button. The component will appear on your form. This will be a square with a representation of a drop-down menu and the component's name, which will default to ''MainMenu1''.<br />
# If you don't like the name '''MainMenu1''', go to the Object Inspector window and change the Name property to something you like better. Let's say we change it to ''XMenu''. Type in '''XMenu''' in the box to the left of the Name property, and push enter. The name on the component changes.<br />
# Right-click on XMenu, and a pop-up menu will appear. For right now, what we want is the first selection, '''Menu Editor'''. Click on it.<br />
# The Menu Editor window will open with a menu item already created with a caption of "New Item1". This will be the top-level menu, similar to the "File Edit View Help" menus you've seen before. You probably want to change this, so click on it, then go to the Object Inspector.<br />
# In object inspector, change the Name property from MenuItem1 to something more appropriate. Let's say this is the File menu, so let's change Name by typing in '''mnuFile''' and press enter.<br />
# We want a better caption than New Item1, so go to the Caption property and type in '''&File''' and press enter. The Ampersand '''&''' in front of the name is an ''accelerator'', that's what allows you to open a menu by pressing the Alt key and the underlined letter. The caption for the menu changes to '''<u>F</u>ile'''.<br />
It is at this point that you create additional top-level menus.<br />
# Go back to the Menu Editor window. Click on <u>F</u>ile, then right-click on it. A pop-up menu will appear. Click on ''Insert New Item After'', and a new menu, called ''New Item2'' will appear. As explained in the last two items, let's change its name to '''mnuHelp''' and the caption to '''&Help''' in the Object Inspector.<br />
# Let's make a menu item under <u>F</u>ile. Right-click on it, then click on '''Create Submenu'''. The file menu now has an arrow on it, and a submenu called ''New Item2'' appears.<br />
# Change this to something related to what it is to do, let's say "Open". Go to the Object inspector, change the Name property to '''mnuFileOpen''', then change the caption to '''&Open'''.<br />
# We need another top-level menu item between '''<u>F</u>ile''' and '''<u>H</u>elp'''. You can either right-click on '''<u>F</u>ile''' and click on '''Insert New Item (after)''' or right-click on '''<u>H</u>elp''' and click on '''Insert New Item (before)'''<br />
# Change this item's name property in the Object Inspector to '''mnuEdit''' and its caption property to '''&Edit'''.<br />
# Continue the above accordingly for each menu and submenu you need.<br />
<br />
Now, all this will get you is a menu that displays at run time and will allow the user to click on the menus. It won't actually do anything. To have the menu items do something, you have to add [[Event_order|events]] for each menu or submenu that is to react to being clicked upon. Usually, top-level menus don't react, the submenus do. You have two choices on how to have the menu react; you can insert the events into the menu, or you can use a [[TActionList]] component. The main reason for using a TActionList is if you plan to have an icon toolbar, say that you have a set of menus with "File" then New, Open, Save, Save As, Quit, etc. as submenus, and you're going to have a toolbar with New, Open, Save and Save As as buttons as well. Rather than writing two routines to handle the New and Open functions, you use a TActionList for both the Menu and the toolbar. How to do that using a TActionList will be explained there. For the mean time, I'll explain how to handle a menu click using an event in the Object Explorer.<br />
<br />
==Making the menu actually do something==<br />
# Go back to the Menu Editor window, click on the '''<u>O</u>pen''' submenu under '''<u>F</u>ile'''. Go to the Object Inspector window, click on the '''Events''' tab. The only event you really want to change is OnClick, which is blank. If you had an existing event handler, you could use it, but since you don't, you can get Lazarus to create it for you. On the right is a button with 3 dots. Click on it, and a new procedure is created in your code, and the view switches to the code window. It will look similar to this.<br />
#:'''procedure''' TfrmMain.mnuFileOpenClick(Sender: TObject);<br />
#:'''begin'''<br/><br/><br />
#:'''end''';<br />
# between tbe '''begin''' and '''end''' statements you would write the code for handling the Open action on the menu. This might include placing a ''TOpenDialog'' control from the Dialogs Tab on your form, and manipulating that dialog to create the standard 'Open' dialog. Same thing applies if you have a '''<u>S</u>ave''' or '''Save <u>a</u>s''' submenu.<br />
# You repeat the above at the point where I mentioned how to start creating additional menus and submenus, and for each one that the user can click upon, you would create handlers for each menu option as needed.<br />
==Check-box menu==<br />
Now, maybe you just want a check-box menu, where when the user clicks on it, it turns a check mark on this box on or off. Let's discuss how to do that.<br />
# Go to the Menu Editor window Click on '''<u>E</u>dit'''<br />
# Let's make a menu item under <u>E</u>dit. Right-click on it, then click on '''Create Submenu'''. go to the Object Inspector window, click on the '''Properties''' tab if it's not already selected. Give this submenu the name '''mnuEditPreserve''' and the caption '''P&reserve case''' (Since Copy and Paste usually use ALT+P and ALT+C we'll use ALT+R for this submenu which is why the ampersand is before the letter r.<br />
# The default value under ''checked'' will be False. If the default state of this menu is checked, double click on the value to flip it from False to True.<br />
# Select the '''Events''' tab, choose the '''Click''' property and click on the ... button.<br />
# Lazarus will switch to the code window, and create the Click event for this submenu.<br />
# within the '''begin''' and '''end''' boxes, all you need is one line, similar to the following:<br />
#: mnuEditPreserve.checked := not mnuEditPreserve.checked ;<br />
# This will flip the value from checked to unchecked. To be able to use this checked menu in your code, just reference '''<code>mnuEditPreserve.checked</code>''' (or whatever the name of the menu is, with the property ''checked''). It's used just as any other [[Boolean]] value.<br />
<br />
==Separators==<br />
Sometimes you want a menu that has a line separating entries. For example, an '''<u>E</u>dit''' menu might have submenus for '''Cut''', '''Copy''' and '''Paste''', then have a separator line before the next submenu. To create a separator line, just make another submenu, and make the caption consist of a single dash (-).<br />
<br />
==ShortCuts==<br />
If you want, you can assign a menu a specific key combination, proceed as follows:<br />
* Select the menu in the menu editor, which should get assigned a keyboard shortcut.<br />
* In the Object Inspector, go to the property ''ShortCut'' and click on the button [...].<br />
* It will appear a window where you can select the desired ShortCut for your menu.<br />
* At run time the event handler of your menu is called with this ShortCut, like you would have clicked on this menu.<br />
<br />
==Image in front of a menu==<br />
If you want to make your menu more visually appealing or establish an optical mapping of the menu entries to a possible toolbar, you can show images in front of the menus. The following steps are necessary:<br />
* Add a [[TImageList]] to your [[TForm|form]]. This is found on the component palette ''Common Controls''. Choose that component TImageList and click on your Form. Now the ImageList named ''ImageList1'' on the form was created. These ImageList will contain all symbols or images to be displayed before the menus.<br />
* Right click now on the ''ImageList1'' and open you the '''ImageList Editor'''.<br />
* Add all the images, one after the other, you need for your menus, to the ImageList. Simply click the button ''Add'' and select as usual an appropriate image.<br />
* When you have added all of the required images in the ImageList, you confirm your selection with [OK] button and the ImageList Editor is closed.<br />
* Now, you have to select your MainMenu, and set the property ''Images'' in the Object Inspector to your ImageList. Simply select your ImageList ''ImageList1'' in the adjacent combobox.<br />
* Now open the menu editor of your menu again and select the menu that you want to get a image.<br />
* Go in the Object Inspector to the property ''ImageIndex'' from your menu and select the image to display in the adjacent combobox.<br />
* In the Menu Editor, select the next menu and choose the corresponding image for it. And so on.<br />
<br />
==Issue: Submenus dropdown to the left (Windows Vista, 7 and 10)==<br />
If you see the pulldown menu aligned to the right of your mainmenu-item, and a submenu opens to the left, it's because your Windows is set to '''Right-handed''' in the '''Tablet PC Settings'''. This is done for when using a tablet and writing/pressing on the screen, the menus are directly visible. If you're right-handed you would want the menus to the left so they are not under your hand. For normal PC operations this is set to left-handed by default.<br />
<br />
You can check this by doing the following:<br />
* Press the Window-key + R.<br />
* Paste in '''shell:::{80F3F1D5-FECA-45F3-BC32-752C152E456E}''' and press enter.<br />
* Goto the tab '''Other'''.<br />
* The default should be '''Left-handed''' for the menus to appear on the right otherwise they appear on the left.<br />
* Note: The arrow for a submenu will still appear on the right of the menu regardless this setting.<br />
<br />
==See also ==<br />
* [[doc:lcl/menus/tmainmenu.html|TMainMenu doc]]<br />
* [[TPopupMenu]]<br />
* [[TActionList]]<br />
<br />
{{LCL Components}}</div>Rvkhttps://wiki.freepascal.org/index.php?title=TMainMenu&diff=111037TMainMenu2017-07-19T13:27:45Z<p>Rvk: </p>
<hr />
<div>{{TMainMenu}}<br />
<br />
A '''TMainMenu''' [[image:tmainmenu.png]] is a non-visual component from the [[Standard tab]] of the [[Component Palette]] that provides a main menu on a form.<br />
<br />
==Description==<br />
The main menu that appears at the top of most windows that form designers can customize by choosing various menu items.<br />
<br />
To see the Menu Editor, right-click on the Main Menu icon on your form.<br />
<br />
==Conventions==<br />
It is common practice to name menus starting with ''mnu'' or ''menu'' and the name of the menu. Submenus continue this by prefixing with the menu they are within, e.g. the 'Cut' submenu in the Edit top-level menu is usually named ''mnuEditCut'' or ''menuEditCut''. This is a mnemonic and makes it easier to remember, six months from now when you need to make changes, how to put them in. Note that this is a ''convention'', it isn't mandatory, but if you do it this way it will probably make it easier to make changes later, or to understand what the code is doing when you haven't been looking at it for a while, or to allow someone else who has to do maintenance on the program you're writing to be able to fix it later.<br />
<br />
Let's get started.<br />
<br />
==Creating Menus==<br />
# Select TMainMenu from the component bar and place a component on your form by clicking on the TMainMenu component, then click on the form but do not let go of the mouse button, and while holding the mouse button down, draw a box and let go of the button. The component will appear on your form. This will be a square with a representation of a drop-down menu and the component's name, which will default to ''MainMenu1''.<br />
# If you don't like the name '''MainMenu1''', go to the Object Inspector window and change the Name property to something you like better. Let's say we change it to ''XMenu''. Type in '''XMenu''' in the box to the left of the Name property, and push enter. The name on the component changes.<br />
# Right-click on XMenu, and a pop-up menu will appear. For right now, what we want is the first selection, '''Menu Editor'''. Click on it.<br />
# The Menu Editor window will open with a menu item already created with a caption of "New Item1". This will be the top-level menu, similar to the "File Edit View Help" menus you've seen before. You probably want to change this, so click on it, then go to the Object Inspector.<br />
# In object inspector, change the Name property from MenuItem1 to something more appropriate. Let's say this is the File menu, so let's change Name by typing in '''mnuFile''' and press enter.<br />
# We want a better caption than New Item1, so go to the Caption property and type in '''&File''' and press enter. The Ampersand '''&''' in front of the name is an ''accelerator'', that's what allows you to open a menu by pressing the Alt key and the underlined letter. The caption for the menu changes to '''<u>F</u>ile'''.<br />
It is at this point that you create additional top-level menus.<br />
# Go back to the Menu Editor window. Click on <u>F</u>ile, then right-click on it. A pop-up menu will appear. Click on ''Insert New Item After'', and a new menu, called ''New Item2'' will appear. As explained in the last two items, let's change its name to '''mnuHelp''' and the caption to '''&Help''' in the Object Inspector.<br />
# Let's make a menu item under <u>F</u>ile. Right-click on it, then click on '''Create Submenu'''. The file menu now has an arrow on it, and a submenu called ''New Item2'' appears.<br />
# Change this to something related to what it is to do, let's say "Open". Go to the Object inspector, change the Name property to '''mnuFileOpen''', then change the caption to '''&Open'''.<br />
# We need another top-level menu item between '''<u>F</u>ile''' and '''<u>H</u>elp'''. You can either right-click on '''<u>F</u>ile''' and click on '''Insert New Item (after)''' or right-click on '''<u>H</u>elp''' and click on '''Insert New Item (before)'''<br />
# Change this item's name property in the Object Inspector to '''mnuEdit''' and its caption property to '''&Edit'''.<br />
# Continue the above accordingly for each menu and submenu you need.<br />
<br />
Now, all this will get you is a menu that displays at run time and will allow the user to click on the menus. It won't actually do anything. To have the menu items do something, you have to add [[Event_order|events]] for each menu or submenu that is to react to being clicked upon. Usually, top-level menus don't react, the submenus do. You have two choices on how to have the menu react; you can insert the events into the menu, or you can use a [[TActionList]] component. The main reason for using a TActionList is if you plan to have an icon toolbar, say that you have a set of menus with "File" then New, Open, Save, Save As, Quit, etc. as submenus, and you're going to have a toolbar with New, Open, Save and Save As as buttons as well. Rather than writing two routines to handle the New and Open functions, you use a TActionList for both the Menu and the toolbar. How to do that using a TActionList will be explained there. For the mean time, I'll explain how to handle a menu click using an event in the Object Explorer.<br />
<br />
==Making the menu actually do something==<br />
# Go back to the Menu Editor window, click on the '''<u>O</u>pen''' submenu under '''<u>F</u>ile'''. Go to the Object Inspector window, click on the '''Events''' tab. The only event you really want to change is OnClick, which is blank. If you had an existing event handler, you could use it, but since you don't, you can get Lazarus to create it for you. On the right is a button with 3 dots. Click on it, and a new procedure is created in your code, and the view switches to the code window. It will look similar to this.<br />
#:'''procedure''' TfrmMain.mnuFileOpenClick(Sender: TObject);<br />
#:'''begin'''<br/><br/><br />
#:'''end''';<br />
# between tbe '''begin''' and '''end''' statements you would write the code for handling the Open action on the menu. This might include placing a ''TOpenDialog'' control from the Dialogs Tab on your form, and manipulating that dialog to create the standard 'Open' dialog. Same thing applies if you have a '''<u>S</u>ave''' or '''Save <u>a</u>s''' submenu.<br />
# You repeat the above at the point where I mentioned how to start creating additional menus and submenus, and for each one that the user can click upon, you would create handlers for each menu option as needed.<br />
==Check-box menu==<br />
Now, maybe you just want a check-box menu, where when the user clicks on it, it turns a check mark on this box on or off. Let's discuss how to do that.<br />
# Go to the Menu Editor window Click on '''<u>E</u>dit'''<br />
# Let's make a menu item under <u>E</u>dit. Right-click on it, then click on '''Create Submenu'''. go to the Object Inspector window, click on the '''Properties''' tab if it's not already selected. Give this submenu the name '''mnuEditPreserve''' and the caption '''P&reserve case''' (Since Copy and Paste usually use ALT+P and ALT+C we'll use ALT+R for this submenu which is why the ampersand is before the letter r.<br />
# The default value under ''checked'' will be False. If the default state of this menu is checked, double click on the value to flip it from False to True.<br />
# Select the '''Events''' tab, choose the '''Click''' property and click on the ... button.<br />
# Lazarus will switch to the code window, and create the Click event for this submenu.<br />
# within the '''begin''' and '''end''' boxes, all you need is one line, similar to the following:<br />
#: mnuEditPreserve.checked := not mnuEditPreserve.checked ;<br />
# This will flip the value from checked to unchecked. To be able to use this checked menu in your code, just reference '''<code>mnuEditPreserve.checked</code>''' (or whatever the name of the menu is, with the property ''checked''). It's used just as any other [[Boolean]] value.<br />
<br />
==Separators==<br />
Sometimes you want a menu that has a line separating entries. For example, an '''<u>E</u>dit''' menu might have submenus for '''Cut''', '''Copy''' and '''Paste''', then have a separator line before the next submenu. To create a separator line, just make another submenu, and make the caption consist of a single dash (-).<br />
<br />
==ShortCuts==<br />
If you want, you can assign a menu a specific key combination, proceed as follows:<br />
* Select the menu in the menu editor, which should get assigned a keyboard shortcut.<br />
* In the Object Inspector, go to the property ''ShortCut'' and click on the button [...].<br />
* It will appear a window where you can select the desired ShortCut for your menu.<br />
* At run time the event handler of your menu is called with this ShortCut, like you would have clicked on this menu.<br />
<br />
==Image in front of a menu==<br />
If you want to make your menu more visually appealing or establish an optical mapping of the menu entries to a possible toolbar, you can show images in front of the menus. The following steps are necessary:<br />
* Add a [[TImageList]] to your [[TForm|form]]. This is found on the component palette ''Common Controls''. Choose that component TImageList and click on your Form. Now the ImageList named ''ImageList1'' on the form was created. These ImageList will contain all symbols or images to be displayed before the menus.<br />
* Right click now on the ''ImageList1'' and open you the '''ImageList Editor'''.<br />
* Add all the images, one after the other, you need for your menus, to the ImageList. Simply click the button ''Add'' and select as usual an appropriate image.<br />
* When you have added all of the required images in the ImageList, you confirm your selection with [OK] button and the ImageList Editor is closed.<br />
* Now, you have to select your MainMenu, and set the property ''Images'' in the Object Inspector to your ImageList. Simply select your ImageList ''ImageList1'' in the adjacent combobox.<br />
* Now open the menu editor of your menu again and select the menu that you want to get a image.<br />
* Go in the Object Inspector to the property ''ImageIndex'' from your menu and select the image to display in the adjacent combobox.<br />
* In the Menu Editor, select the next menu and choose the corresponding image for it. And so on.<br />
<br />
==Issue: Menus are right aligned to the mainmenu-item and submenus dropdown on the left (Windows Vista, 7 and 10)==<br />
If you see the pulldown menu aligned to the right of your mainmenu-item, and a submenu opens to the left, it's because your Windows is set to '''Right-handed''' in the '''Tablet PC Settings'''. You can check this by doing the following:<br />
* Press the Window-key + R.<br />
* Paste in '''shell:::{80F3F1D5-FECA-45F3-BC32-752C152E456E}''' and press enter.<br />
* Goto the tab '''Other'''.<br />
* The default should be '''Left-handed''' for the menus to appear on the right otherwise they appear on the left.<br />
* Note: The arrow for a submenu will still appear on the right of the menu regardless this setting.<br />
<br />
==See also ==<br />
* [[doc:lcl/menus/tmainmenu.html|TMainMenu doc]]<br />
* [[TPopupMenu]]<br />
* [[TActionList]]<br />
<br />
{{LCL Components}}</div>Rvkhttps://wiki.freepascal.org/index.php?title=TMainMenu&diff=111036TMainMenu2017-07-19T13:25:17Z<p>Rvk: </p>
<hr />
<div>{{TMainMenu}}<br />
<br />
A '''TMainMenu''' [[image:tmainmenu.png]] is a non-visual component from the [[Standard tab]] of the [[Component Palette]] that provides a main menu on a form.<br />
<br />
==Description==<br />
The main menu that appears at the top of most windows that form designers can customize by choosing various menu items.<br />
<br />
To see the Menu Editor, right-click on the Main Menu icon on your form.<br />
<br />
==Conventions==<br />
It is common practice to name menus starting with ''mnu'' or ''menu'' and the name of the menu. Submenus continue this by prefixing with the menu they are within, e.g. the 'Cut' submenu in the Edit top-level menu is usually named ''mnuEditCut'' or ''menuEditCut''. This is a mnemonic and makes it easier to remember, six months from now when you need to make changes, how to put them in. Note that this is a ''convention'', it isn't mandatory, but if you do it this way it will probably make it easier to make changes later, or to understand what the code is doing when you haven't been looking at it for a while, or to allow someone else who has to do maintenance on the program you're writing to be able to fix it later.<br />
<br />
Let's get started.<br />
<br />
==Creating Menus==<br />
# Select TMainMenu from the component bar and place a component on your form by clicking on the TMainMenu component, then click on the form but do not let go of the mouse button, and while holding the mouse button down, draw a box and let go of the button. The component will appear on your form. This will be a square with a representation of a drop-down menu and the component's name, which will default to ''MainMenu1''.<br />
# If you don't like the name '''MainMenu1''', go to the Object Inspector window and change the Name property to something you like better. Let's say we change it to ''XMenu''. Type in '''XMenu''' in the box to the left of the Name property, and push enter. The name on the component changes.<br />
# Right-click on XMenu, and a pop-up menu will appear. For right now, what we want is the first selection, '''Menu Editor'''. Click on it.<br />
# The Menu Editor window will open with a menu item already created with a caption of "New Item1". This will be the top-level menu, similar to the "File Edit View Help" menus you've seen before. You probably want to change this, so click on it, then go to the Object Inspector.<br />
# In object inspector, change the Name property from MenuItem1 to something more appropriate. Let's say this is the File menu, so let's change Name by typing in '''mnuFile''' and press enter.<br />
# We want a better caption than New Item1, so go to the Caption property and type in '''&File''' and press enter. The Ampersand '''&''' in front of the name is an ''accelerator'', that's what allows you to open a menu by pressing the Alt key and the underlined letter. The caption for the menu changes to '''<u>F</u>ile'''.<br />
It is at this point that you create additional top-level menus.<br />
# Go back to the Menu Editor window. Click on <u>F</u>ile, then right-click on it. A pop-up menu will appear. Click on ''Insert New Item After'', and a new menu, called ''New Item2'' will appear. As explained in the last two items, let's change its name to '''mnuHelp''' and the caption to '''&Help''' in the Object Inspector.<br />
# Let's make a menu item under <u>F</u>ile. Right-click on it, then click on '''Create Submenu'''. The file menu now has an arrow on it, and a submenu called ''New Item2'' appears.<br />
# Change this to something related to what it is to do, let's say "Open". Go to the Object inspector, change the Name property to '''mnuFileOpen''', then change the caption to '''&Open'''.<br />
# We need another top-level menu item between '''<u>F</u>ile''' and '''<u>H</u>elp'''. You can either right-click on '''<u>F</u>ile''' and click on '''Insert New Item (after)''' or right-click on '''<u>H</u>elp''' and click on '''Insert New Item (before)'''<br />
# Change this item's name property in the Object Inspector to '''mnuEdit''' and its caption property to '''&Edit'''.<br />
# Continue the above accordingly for each menu and submenu you need.<br />
<br />
Now, all this will get you is a menu that displays at run time and will allow the user to click on the menus. It won't actually do anything. To have the menu items do something, you have to add [[Event_order|events]] for each menu or submenu that is to react to being clicked upon. Usually, top-level menus don't react, the submenus do. You have two choices on how to have the menu react; you can insert the events into the menu, or you can use a [[TActionList]] component. The main reason for using a TActionList is if you plan to have an icon toolbar, say that you have a set of menus with "File" then New, Open, Save, Save As, Quit, etc. as submenus, and you're going to have a toolbar with New, Open, Save and Save As as buttons as well. Rather than writing two routines to handle the New and Open functions, you use a TActionList for both the Menu and the toolbar. How to do that using a TActionList will be explained there. For the mean time, I'll explain how to handle a menu click using an event in the Object Explorer.<br />
<br />
==Making the menu actually do something==<br />
# Go back to the Menu Editor window, click on the '''<u>O</u>pen''' submenu under '''<u>F</u>ile'''. Go to the Object Inspector window, click on the '''Events''' tab. The only event you really want to change is OnClick, which is blank. If you had an existing event handler, you could use it, but since you don't, you can get Lazarus to create it for you. On the right is a button with 3 dots. Click on it, and a new procedure is created in your code, and the view switches to the code window. It will look similar to this.<br />
#:'''procedure''' TfrmMain.mnuFileOpenClick(Sender: TObject);<br />
#:'''begin'''<br/><br/><br />
#:'''end''';<br />
# between tbe '''begin''' and '''end''' statements you would write the code for handling the Open action on the menu. This might include placing a ''TOpenDialog'' control from the Dialogs Tab on your form, and manipulating that dialog to create the standard 'Open' dialog. Same thing applies if you have a '''<u>S</u>ave''' or '''Save <u>a</u>s''' submenu.<br />
# You repeat the above at the point where I mentioned how to start creating additional menus and submenus, and for each one that the user can click upon, you would create handlers for each menu option as needed.<br />
==Check-box menu==<br />
Now, maybe you just want a check-box menu, where when the user clicks on it, it turns a check mark on this box on or off. Let's discuss how to do that.<br />
# Go to the Menu Editor window Click on '''<u>E</u>dit'''<br />
# Let's make a menu item under <u>E</u>dit. Right-click on it, then click on '''Create Submenu'''. go to the Object Inspector window, click on the '''Properties''' tab if it's not already selected. Give this submenu the name '''mnuEditPreserve''' and the caption '''P&reserve case''' (Since Copy and Paste usually use ALT+P and ALT+C we'll use ALT+R for this submenu which is why the ampersand is before the letter r.<br />
# The default value under ''checked'' will be False. If the default state of this menu is checked, double click on the value to flip it from False to True.<br />
# Select the '''Events''' tab, choose the '''Click''' property and click on the ... button.<br />
# Lazarus will switch to the code window, and create the Click event for this submenu.<br />
# within the '''begin''' and '''end''' boxes, all you need is one line, similar to the following:<br />
#: mnuEditPreserve.checked := not mnuEditPreserve.checked ;<br />
# This will flip the value from checked to unchecked. To be able to use this checked menu in your code, just reference '''<code>mnuEditPreserve.checked</code>''' (or whatever the name of the menu is, with the property ''checked''). It's used just as any other [[Boolean]] value.<br />
<br />
==Separators==<br />
Sometimes you want a menu that has a line separating entries. For example, an '''<u>E</u>dit''' menu might have submenus for '''Cut''', '''Copy''' and '''Paste''', then have a separator line before the next submenu. To create a separator line, just make another submenu, and make the caption consist of a single dash (-).<br />
<br />
==ShortCuts==<br />
If you want, you can assign a menu a specific key combination, proceed as follows:<br />
* Select the menu in the menu editor, which should get assigned a keyboard shortcut.<br />
* In the Object Inspector, go to the property ''ShortCut'' and click on the button [...].<br />
* It will appear a window where you can select the desired ShortCut for your menu.<br />
* At run time the event handler of your menu is called with this ShortCut, like you would have clicked on this menu.<br />
<br />
==Image in front of a menu==<br />
If you want to make your menu more visually appealing or establish an optical mapping of the menu entries to a possible toolbar, you can show images in front of the menus. The following steps are necessary:<br />
* Add a [[TImageList]] to your [[TForm|form]]. This is found on the component palette ''Common Controls''. Choose that component TImageList and click on your Form. Now the ImageList named ''ImageList1'' on the form was created. These ImageList will contain all symbols or images to be displayed before the menus.<br />
* Right click now on the ''ImageList1'' and open you the '''ImageList Editor'''.<br />
* Add all the images, one after the other, you need for your menus, to the ImageList. Simply click the button ''Add'' and select as usual an appropriate image.<br />
* When you have added all of the required images in the ImageList, you confirm your selection with [OK] button and the ImageList Editor is closed.<br />
* Now, you have to select your MainMenu, and set the property ''Images'' in the Object Inspector to your ImageList. Simply select your ImageList ''ImageList1'' in the adjacent combobox.<br />
* Now open the menu editor of your menu again and select the menu that you want to get a image.<br />
* Go in the Object Inspector to the property ''ImageIndex'' from your menu and select the image to display in the adjacent combobox.<br />
* In the Menu Editor, select the next menu and choose the corresponding image for it. And so on.<br />
<br />
==Issue: Menus are right aligned to the mainmenu-item and submenus dropdown on the left (Windows Vista, 7 and 10)==<br />
If you see the pulldown menu aligned to the right of your mainmenu-item, and a submenu opens to the left, it's because your Windows is set to '''Right-handed''' in the "Tablet PC Settings". You can check this by doing the following:<br />
* Press the Window-key + R.<br />
* Paste in '''shell:::{80F3F1D5-FECA-45F3-BC32-752C152E456E}''' and press enter.<br />
* Goto the tab '''Other'''.<br />
* The default should be "Left-handed" for the menus to appear on the right otherwise they appear on the left.<br />
* Note: The arrow for a submenu will still appear on the right of the menu regardless this setting.<br />
<br />
==See also ==<br />
* [[doc:lcl/menus/tmainmenu.html|TMainMenu doc]]<br />
* [[TPopupMenu]]<br />
* [[TActionList]]<br />
<br />
{{LCL Components}}</div>Rvkhttps://wiki.freepascal.org/index.php?title=Synapse&diff=104438Synapse2016-10-11T09:44:46Z<p>Rvk: SSHCheck() after libssh2_channel_open_session().</p>
<hr />
<div>Synapse provides an easy to use serial port and synchronous TCP/IP library.<br />
<br />
__TOC__<br />
{{Web and Networking Programming}}<br />
<br />
=Overview=<br />
Synapse offers serial port and TCP/IP connectivity. It differs from other libraries that you only require to add some Synapse Pascal source code files to your code; no need for installing packages etc. The only exception is that you will need an external crypto library if you want to use encryption such as SSL/TLS/SSH. <br />
<br />
See the documentation on the official site (link below) for more details.<br />
<br />
=Installation=<br />
Installation can be as simple as simply copying over all files to your application directory and adding the relevant Synapse units to your ''uses'' clause.<br />
<br />
A more elegant and recommended way is compiling the laz_synapse.lpk package so you can use the same units in all your projects.<br />
<br />
Synapse download/SVN info page: [http://www.ararat.cz/synapse/doku.php/download Synapse download page]<br />
<br />
=Support and bug reporting=<br />
The Synapse project has a mailing list where support is given and patches can be submitted.<br />
<br />
Bug reports can also be mailed to the mailing list.<br />
<br />
See the [http://www.ararat.cz/synapse/doku.php/support Synapse support page]<br />
<br />
=SSL/TLS support=<br />
<br />
You can use OpenSSL, CryptLib, StreamSecII or OpenStreamSecII SSL support with Synapse. By default, no SSL support is used. <br />
<br />
The support is activated by putting the chosen unit name in the uses section in your project. You also have to put the binary library file in your project path (Windows), or install it into your library search path (Linux, OSX). <br />
<br />
Synapse loads SSL library files in runtime as dynamic libraries.<br />
<br />
* For detailed information refer to [http://www.ararat.cz/synapse/doku.php/public:howto:sslplugin SSL/TLS Plugin Architecture]<br />
* Some crypt libraries can be obtained from: http://synapse.ararat.cz/files/crypt/<br />
<br />
==Missing library==<br />
<br />
On Linux you need to make sure the required dynamic library is present/installed on your system. In case of cryptlib if the library is not present on the system, an error message appears during linking:<br />
<br />
<pre>/usr/bin/ld: cannot find -lcl</pre><br />
<br />
A similar message will be displayed when using other dynamic libraries.<br />
<br />
=Web server example=<br />
See [[Networking#Webserver example]]<br />
<br />
=Sending email=<br />
<br />
Article that covers sending email, including attachments, using Synapse: http://www.freepascal.org/~michael/articles/lazmail/lazmail-en.pdf<br />
<br />
From forum post [http://forum.lazarus.freepascal.org/index.php/topic,21157.msg123501.html#msg123501]; works with e.g. gmail:<br />
<br />
This code supports using TLS/SSL encryption; if sending to port 25 it uses plain-text SMTP.<br />
<br />
<syntaxhighlight><br />
uses<br />
..., smtpsend,ssl_openssl; //probably other ssl units can be used, too.<br />
<br />
// MailData is the text of the mail.<br />
function SendMail(<br />
User, Password, <br />
MailFrom, MailTo, <br />
SMTPHost, SMTPPort: string; <br />
MailData: string): Boolean;<br />
var<br />
SMTP: TSMTPSend;<br />
sl:TStringList;<br />
begin<br />
Result:=False;<br />
SMTP:=TSMTPSend.Create;<br />
sl:=TStringList.Create;<br />
try<br />
sl.text:=Maildata;<br />
SMTP.UserName:=User;<br />
SMTP.Password:=Password;<br />
SMTP.TargetHost:=SMTPHost;<br />
SMTP.TargetPort:=SMTPPort;<br />
SMTP.AutoTLS:=true;<br />
if Trim(SMTPPort)<>'25' then<br />
SMTP.FullSSL:=true; // if sending to port 25, don't use encryption<br />
if SMTP.Login then<br />
begin<br />
result:=SMTP.MailFrom(MailFrom, Length(MailData)) and<br />
SMTP.MailTo(MailTo) and<br />
SMTP.MailData(sl);<br />
SMTP.Logout;<br />
end;<br />
finally<br />
SMTP.Free;<br />
sl.Free;<br />
end;<br />
end;<br />
</syntaxhighlight><br />
<br />
== Sending attachments ==<br />
Please see the Synapse documentation: <br />
http://synapse.ararat.cz/doku.php/public:howto:tmimepart<br />
<br />
=Downloading files=<br />
<br />
==From an FTP server==<br />
Given an URL and a (path and) file name, this will download it from an FTP server.<br />
It's mostly a wrapper around the Synapse code meant to make downloading easier when handling arbitrary files.<br />
If you know exactly what you're going to download where, just a call to Synapse<br />
<syntaxhighlight><br />
FtpGetFile<br />
</syntaxhighlight><br />
will get you very far.<br />
<br />
<syntaxhighlight><br />
function DownloadFTP(URL, TargetFile: string): boolean;<br />
const<br />
FTPPort=21;<br />
FTPScheme='ftp://'; //URI scheme name for FTP URLs<br />
var<br />
Host: string;<br />
Port: integer;<br />
Source: string;<br />
FoundPos: integer;<br />
begin<br />
// Strip out scheme info:<br />
if LeftStr(URL, length(FTPScheme))=FTPScheme then URL:=Copy(URL, length(FTPScheme)+1, length(URL));<br />
<br />
// Crude parsing; could have used URI parsing code in FPC packages...<br />
FoundPos:=pos('/', URL);<br />
Host:=LeftStr(URL, FoundPos-1);<br />
Source:=Copy(URL, FoundPos+1, Length(URL));<br />
<br />
//Check for port numbers:<br />
FoundPos:=pos(':', Host);<br />
Port:=FTPPort;<br />
if FoundPos>0 then<br />
begin<br />
Host:=LeftStr(Host, FoundPos-1);<br />
Port:=StrToIntDef(Copy(Host, FoundPos+1, Length(Host)),21);<br />
end;<br />
Result:=FtpGetFile(Host, IntToStr(Port), Source, TargetFile, 'anonymous', 'fpc@example.com');<br />
if result=false then writeln('DownloadFTP: error downloading '+URL+'. Details: host: '+Host+'; port: '+Inttostr(Port)+'; remote path: '+Source+' to '+TargetFile);<br />
end;<br />
</syntaxhighlight><br />
<br />
Example to get list of files in given path<br />
<br />
<syntaxhighlight><br />
//Use ftpsend unit<br />
<br />
function FtpGetDir(const IP, Port, Path, User, Pass: string; DirList: TStringList): Boolean;<br />
var<br />
i: Integer;<br />
s: string;<br />
begin<br />
Result := False;<br />
with TFTPSend.Create do<br />
try<br />
Username := User;<br />
Password := Pass;<br />
TargetHost := IP;<br />
TargetPort := Port;<br />
if not Login then<br />
Exit;<br />
Result := List(Path, False);<br />
for i := 0 to FtpList.Count -1 do<br />
begin<br />
s := FTPList[i].FileName;<br />
DirList.Add(s);<br />
end;<br />
Logout;<br />
finally<br />
Free;<br />
end;<br />
end; <br />
</syntaxhighlight><br />
<br />
== From an HTTP server ==<br />
Given an URL and a (path and) file name, this will download it from an HTTP server.<br />
Note that this code checks the HTTP status code (like 200, 404) to see if the document we got back from the server is the desired file or an error page.<br />
<br />
===Simple version===<br />
<syntaxhighlight><br />
...<br />
uses httpsend,<br />
...<br />
function DownloadHTTP(URL, TargetFile: string): Boolean;<br />
var<br />
HTTPGetResult: Boolean;<br />
HTTPSender: THTTPSend;<br />
begin<br />
Result := False;<br />
HTTPSender := THTTPSend.Create;<br />
try<br />
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);<br />
if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin<br />
HTTPSender.Document.SaveToFile(TargetFile);<br />
Result := True;<br />
end; <br />
finally<br />
HTTPSender.Free;<br />
end;<br />
end;</syntaxhighlight><br />
<br />
===Advanced version===<br />
<syntaxhighlight><br />
...<br />
uses httpsend<br />
...<br />
function DownloadHTTP(URL, TargetFile: string): Boolean;<br />
// Download file; retry if necessary.<br />
// Could use Synapse HttpGetBinary, but that doesn't deal<br />
// with result codes (i.e. it happily downloads a 404 error document)<br />
const<br />
MaxRetries = 3;<br />
var<br />
HTTPGetResult: Boolean;<br />
HTTPSender: THTTPSend;<br />
RetryAttempt: Integer;<br />
begin<br />
Result := False;<br />
RetryAttempt := 1;<br />
HTTPSender := THTTPSend.Create;<br />
try<br />
try<br />
// Try to get the file<br />
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);<br />
while (HTTPGetResult = False) and (RetryAttempt < MaxRetries) do<br />
begin<br />
Sleep(500 * RetryAttempt);<br />
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);<br />
RetryAttempt := RetryAttempt + 1;<br />
end;<br />
// If we have an answer from the server, check if the file<br />
// was sent to us.<br />
case HTTPSender.Resultcode of<br />
100..299:<br />
begin<br />
HTTPSender.Document.SaveToFile(TargetFile);<br />
Result := True;<br />
end; //informational, success<br />
300..399: Result := False; // redirection. Not implemented, but could be.<br />
400..499: Result := False; // client error; 404 not found etc<br />
500..599: Result := False; // internal server error<br />
else Result := False; // unknown code<br />
end;<br />
except<br />
// We don't care for the reason for this error; the download failed.<br />
Result := False;<br />
end;<br />
finally<br />
HTTPSender.Free;<br />
end;<br />
end;<br />
</syntaxhighlight><br />
<br />
=== Simple version with progress ===<br />
<br />
The following example shows how to get progress information from the HTTP download, as well as the file size.<br />
The file size is retrieved from the header information. <br />
<br />
<syntaxhighlight><br />
unit uhttpdownloader;<br />
<br />
{$mode Delphi}{$H+}<br />
<br />
interface<br />
<br />
uses<br />
Classes, SysUtils, httpsend, blcksock, typinfo;<br />
<br />
//Interface for notifications about the progress<br />
type<br />
IProgress = interface<br />
procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);<br />
end;<br />
<br />
type<br />
{ THttpDownloader }<br />
<br />
THttpDownloader = class<br />
public<br />
function DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;<br />
private<br />
Bytes : Integer;<br />
MaxBytes : Integer;<br />
HTTPSender: THTTPSend;<br />
ProgressMonitor : IProgress;<br />
procedure Status(Sender: TObject; Reason: THookSocketReason; const Value: String);<br />
function GetSizeFromHeader(Header: String):integer;<br />
end;<br />
<br />
implementation<br />
<br />
function THttpDownloader.DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;<br />
var<br />
HTTPGetResult: Boolean;<br />
begin<br />
Result := False;<br />
Bytes:= 0;<br />
MaxBytes:= -1;<br />
Self.ProgressMonitor:= ProgressMonitor;<br />
<br />
HTTPSender := THTTPSend.Create;<br />
try<br />
//add callback function for status updates<br />
HTTPSender.Sock.OnStatus:= Status;<br />
HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);<br />
if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin<br />
HTTPSender.Document.SaveToFile(TargetFile);<br />
Result := True;<br />
end;<br />
finally<br />
HTTPSender.Free;<br />
end;<br />
end;<br />
<br />
//Callback function for status events<br />
procedure THttpDownloader.Status(Sender: TObject; Reason: THookSocketReason; const Value: String);<br />
var<br />
V, currentHeader: String;<br />
i: integer;<br />
begin<br />
//try to get filesize from headers<br />
if (MaxBytes = -1) then<br />
begin<br />
for i:= 0 to HTTPSender.Headers.Count - 1 do<br />
begin<br />
currentHeader:= HTTPSender.Headers[i];<br />
MaxBytes:= GetSizeFromHeader(currentHeader);<br />
if MaxBytes <> -1 then break;<br />
end;<br />
end;<br />
<br />
V := GetEnumName(TypeInfo(THookSocketReason), Integer(Reason)) + ' ' + Value;<br />
<br />
//HR_ReadCount contains the number of bytes since the last event<br />
if Reason = THookSocketReason.HR_ReadCount then<br />
begin<br />
Bytes:= Bytes + StrToInt(Value);<br />
ProgressMonitor.ProgressNotification(V, Bytes, MaxBytes);<br />
end;<br />
end;<br />
<br />
function THttpDownloader.GetSizeFromHeader(Header: String): integer;<br />
var<br />
item : TStringList;<br />
begin<br />
//the download size is contained in the header (e.g.: Content-Length: 3737722)<br />
Result:= -1;<br />
<br />
if Pos('Content-Length:', Header) <> 0 then<br />
begin<br />
item:= TStringList.Create();<br />
item.Delimiter:= ':';<br />
item.StrictDelimiter:=true;<br />
item.DelimitedText:=Header;<br />
if item.Count = 2 then<br />
begin<br />
Result:= StrToInt(Trim(item[1]));<br />
end;<br />
end;<br />
end;<br />
end.<br />
<br />
</syntaxhighlight><br />
<br />
<br />
=== From an HTTP server by parsing URLs: Sourceforge ===<br />
Please see [[Download from SourceForge]] for an example of downloading from sourceforge.net.<br />
<br />
== From an HTTPS server ==<br />
<br />
This is similar to downloading from the HTTP server. In addition you need activate one of [[Synapse#SSL.2FTLS_support SSL/TLC plugin]] and obtain binary files of need library. Then you can same DownloadHTTP function for downloading file from URL starting with '''https://'''.<br />
<br />
=SSH/Telnet client sample program=<br />
Below you will find a unit that allows you to use telnet/SSH client functionality that uses the synapse tlntsend.pas unit. An example program shows how to use this.<br />
A different, simpler way is illustrated by Leonardo Ramé at [http://leonardorame.blogspot.com/2010/01/synapse-based-ssh-client.html]. His example cannot use telnet and only sends one command, though.<br />
<br />
== Requirements ==<br />
Apart from the Synapse sources (of which you only need a couple), if you want to use SSH functionality, you will need an encryption library that Synapse uses. If you only use Telnet, you don't need this.<br />
<br />
There are 2 choices:<br />
* Cryptlib library. Advantage: stable. Apparently able to use private keys but these are in some format that is not widely supported.<br />
* LibSSH2 library. Pascal bindings still in development, but you can use a file with your private key (in OpenSSH format) to authenticate.<br />
<br />
=== Cryptlib ===<br />
* On Windows, download a binary version of the cryptlib DLL (CL32.DLL) and put it in your source directory. If you compile to a different directory or distribute your program, you will need to distribute the DLL as well.<br />
* On Linux and OSX, install cryptlib via your package manager/other means. When distributing your application, mark cryptlib as a requirement in your .deb/.rpm/whatever package.<br />
<br />
You will also need the bindings (cryptlib.pas), present in the source distribution of cryptlib.<br />
<br />
The versions of the cryptlib binary and the bindings must match.<br />
<br />
{{Note|It seems that cryptlib is not suitable to connect to linux machines, though AIX works. Use SSH2 instead.}}<br />
<br />
=== LibSSH2 ===<br />
* On Windows, download a binary version of the libssh2 DLL (LIBSSH2.DLL) and put it in your source directory. If you compile to a different directory or distribute your program, you will need to distribute the DLL as well.<br />
* On Linux and OSX, install libssh2 via your package manager/other means. When distributing your application, mark libssh2 as a requirement in your .deb/.rpm/whatever package.<br />
<br />
You will also need ssl_libssh2.pas (see below) and the bindings: (libssh2.pas, see [http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465]).<br />
<br />
The libssh2 binary and the bindings must match.<br />
<br />
== Synapse libssh2 SSL plugin ==<br />
{{Note| plugin not completed.}}<br />
<br />
<syntaxhighlight><br />
{<br />
ssl_libssh2.pas version 0.2<br />
<br />
SSH2 support (draft) plugin for Synapse Library (http://www.ararat.cz/synapse) by LibSSH2 (http://libssh2.org)<br />
Requires: libssh2 pascal interface - http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465 and<br />
libssh2.dll with OpenSSL.<br />
<br />
(С) Alexey Suhinin http://x-alexey.narod.ru<br />
}<br />
<br />
{$IFDEF FPC}<br />
{$MODE DELPHI}<br />
{$ENDIF}<br />
{$H+}<br />
<br />
unit ssl_libssh2;<br />
<br />
interface<br />
<br />
uses<br />
SysUtils,<br />
blcksock, synsock,<br />
libssh2;<br />
<br />
type<br />
{:@abstract(class implementing CryptLib SSL/SSH plugin.)<br />
Instance of this class will be created for each @link(TTCPBlockSocket).<br />
You not need to create instance of this class, all is done by Synapse itself!}<br />
TSSLLibSSH2 = class(TCustomSSL)<br />
protected<br />
FSession: PLIBSSH2_SESSION;<br />
FChannel: PLIBSSH2_CHANNEL;<br />
function SSHCheck(Value: integer): Boolean;<br />
function DeInit: Boolean;<br />
public<br />
{:See @inherited}<br />
constructor Create(const Value: TTCPBlockSocket); override;<br />
destructor Destroy; override;<br />
function Connect: boolean; override;<br />
function LibName: String; override;<br />
function Shutdown: boolean; override;<br />
{:See @inherited}<br />
function BiShutdown: boolean; override;<br />
{:See @inherited}<br />
function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;<br />
{:See @inherited}<br />
function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;<br />
{:See @inherited}<br />
function WaitingData: Integer; override;<br />
{:See @inherited}<br />
function GetSSLVersion: string; override;<br />
published<br />
end;<br />
<br />
implementation<br />
<br />
{==============================================================================}<br />
function TSSLLibSSH2.SSHCheck(Value: integer): Boolean;<br />
var<br />
PLastError: PAnsiChar;<br />
ErrMsgLen: Integer;<br />
begin<br />
Result := true;<br />
FLastError := 0;<br />
FLastErrorDesc := '';<br />
if Value<0 then<br />
begin<br />
FLastError := libssh2_session_last_error(FSession, PLastError, ErrMsglen, 0);<br />
FLastErrorDesc := PLastError;<br />
Result := false;<br />
end;<br />
end;<br />
<br />
<br />
function TSSLLibSSH2.DeInit: Boolean;<br />
begin<br />
if Assigned(FChannel) then<br />
begin<br />
libssh2_channel_free(FChannel);<br />
FChannel := nil;<br />
end;<br />
if Assigned(FSession) then<br />
begin<br />
libssh2_session_disconnect(FSession,'Goodbye');<br />
libssh2_session_free(FSession);<br />
FSession := nil;<br />
end;<br />
FSSLEnabled := False;<br />
Result := true;<br />
end;<br />
<br />
constructor TSSLLibSSH2.Create(const Value: TTCPBlockSocket);<br />
begin<br />
inherited Create(Value);<br />
FSession := nil;<br />
FChannel := nil;<br />
end;<br />
<br />
destructor TSSLLibSSH2.Destroy;<br />
begin<br />
DeInit;<br />
inherited Destroy;<br />
end;<br />
<br />
function TSSLLibSSH2.Connect: boolean;<br />
begin<br />
Result := False;<br />
if SSLEnabled then DeInit;<br />
if (FSocket.Socket <> INVALID_SOCKET) and (FSocket.SSL.SSLType = LT_SSHv2) then<br />
begin<br />
FSession := libssh2_session_init();<br />
if not Assigned(FSession) then<br />
begin<br />
FLastError := -999;<br />
FLastErrorDesc := 'Cannot initialize SSH session';<br />
exit;<br />
end;<br />
if not SSHCheck(libssh2_session_startup(FSession, FSocket.Socket)) then<br />
exit;<br />
if (FSocket.SSL.PrivateKeyFile<>'') then<br />
begin<br />
if (not SSHCheck(libssh2_userauth_publickey_fromfile(FSession, PChar(FSocket.SSL.Username), nil, PChar(FSocket.SSL.PrivateKeyFile), PChar(FSocket.SSL.KeyPassword)))) then<br />
exit;<br />
end<br />
else<br />
if (FSocket.SSL.Username<>'') and (FSocket.SSL.Password<>'') then<br />
begin<br />
if (not SSHCheck(libssh2_userauth_password(FSession, PChar(FSocket.SSL.Username), PChar(FSocket.SSL.Password)))) then<br />
exit;<br />
end;<br />
FChannel := libssh2_channel_open_session(FSession);<br />
if not assigned(FChannel) then<br />
begin<br />
SSHCheck(-1); // get error<br />
if FLastError = 0 then<br />
begin<br />
FLastError := -999; // unknown error<br />
FLastErrorDesc := 'Cannot open session';<br />
end;<br />
exit;<br />
end;<br />
if not SSHCheck(libssh2_channel_request_pty(FChannel, 'vanilla')) then<br />
exit;<br />
if not SSHCheck(libssh2_channel_shell(FChannel)) then<br />
exit;<br />
FSSLEnabled := True;<br />
Result := True;<br />
end;<br />
end;<br />
<br />
function TSSLLibSSH2.LibName: String;<br />
begin<br />
Result := 'ssl_libssh2';<br />
end;<br />
<br />
function TSSLLibSSH2.Shutdown: boolean;<br />
begin<br />
Result := DeInit;<br />
end;<br />
<br />
<br />
function TSSLLibSSH2.BiShutdown: boolean;<br />
begin<br />
Result := DeInit;<br />
end;<br />
<br />
function TSSLLibSSH2.SendBuffer(Buffer: TMemory; Len: Integer): Integer;<br />
begin<br />
Result:=libssh2_channel_write(FChannel, PChar(Buffer), Len);<br />
SSHCheck(Result);<br />
end;<br />
<br />
function TSSLLibSSH2.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;<br />
begin<br />
result:=libssh2_channel_read(FChannel, PChar(Buffer), Len);<br />
SSHCheck(Result);<br />
end;<br />
<br />
function TSSLLibSSH2.WaitingData: Integer;<br />
begin<br />
if libssh2_poll_channel_read(FChannel, Result) <> 1 then Result := 0;<br />
end;<br />
<br />
function TSSLLibSSH2.GetSSLVersion: string;<br />
begin<br />
Result:=libssh2_version(0);<br />
end;<br />
<br />
initialization<br />
if libssh2_init(0)=0 then<br />
SSLImplementation := TSSLLibSSH2;<br />
<br />
finalization<br />
libssh2_exit;<br />
<br />
end.<br />
</syntaxhighlight><br />
<br />
== Terminal client class ==<br />
The telnetsshclient.pas unit below wraps around the Synapse tlntsend.pas unit and abstracts logging in, sending commands and receiving output and logging out.<br />
<br />
If you only need a telnet client and can live without SSH support, comment out {$DEFINE HAS_SSH_SUPPORT} below so you don't need to have the libssh2 dll.<br />
<br />
This unit has been lightly tested on a Linux ssh/telnet server. Additional tests welcome.<br />
<br />
<syntaxhighlight><br />
unit telnetsshclient;<br />
<br />
{ Wrapper around Synapse libraries and SSL library (libssh2+libssl<br />
is used right now)<br />
Download compiled Windows dll from e.g.<br />
http://alxdm.dyndns-at-work.com:808/files/windll_libssh2.zip<br />
Download FreePascal interface files:<br />
http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465<br />
<br />
This unit allows the user to send Telnet or SSH commands and get the output<br />
Thanks to Leonardo Rame<br />
http://leonardorame.blogspot.com/2010/01/synapse-based-ssh-client.html<br />
and Ludo Brands.<br />
<br />
Written by Reinier Olislagers 2011.<br />
Modified for libssh2 by Alexey Suhinin 2012.<br />
<br />
License of code:<br />
* MIT<br />
* LGPLv2 or later (with FreePascal static linking exception)<br />
* GPLv2 or later<br />
according to your choice.<br />
Free use allowed but please don't sue or blame me.<br />
<br />
Uses other libraries/components; different licenses may apply that also can influence the combined/compiled work.<br />
}<br />
<br />
{$mode objfpc}{$H+}<br />
{$DEFINE HAS_SSH_SUPPORT} //comment out if only telnet support required<br />
{$DEFINE LIBSSH2}<br />
<br />
interface<br />
<br />
uses<br />
Classes, SysUtils,<br />
tlntsend<br />
{$IFDEF HAS_SSH_SUPPORT}<br />
{ssl - or actually ssh - libs required by tlntsend}<br />
{$IFDEF LIBSSH2}<br />
ssl_libssh2<br />
{$ELSE}<br />
ssl_cryptlib<br />
{$ENDIF}<br />
{$ENDIF HAS_SSH_SUPPORT} ;<br />
<br />
type<br />
TProtocolType = (Telnet, SSH); //Different means of connecting<br />
TServerType = (Unix, Windows); //line endings, mostly<br />
{ TelnetSSHClient }<br />
<br />
{ TTelnetSSHClient }<br />
<br />
TTelnetSSHClient = class(TTelnetSend)<br />
protected<br />
FConnected: boolean;<br />
FOutputPosition: integer; //Keeps track of position in output stream<br />
FProtocolType: TProtocolType;<br />
FServerLineEnding: string; //depends on FServerType<br />
FServerType: TServerType;<br />
FWelcomeMessage, FTelnetLoginPrompt, FTelnetPasswordPrompt: string;<br />
procedure SetPrivateKeyFile(Value: string);<br />
function GetPrivateKeyFile: string;<br />
{ Based on protocol and servertype, set expected serverside line ending}<br />
procedure DetermineLineEnding;<br />
{ Sets port if no explicit port set. Uses protocol type: SSH or telnet}<br />
procedure DeterminePort;<br />
function GetSessionLog: string;<br />
procedure ProtocolTypeChange(Value: TProtocolType);<br />
function ReceiveData: string; //Can be used to get welcome message etc.<br />
procedure SendData(Data: string);<br />
procedure ServerTypeChange(Value: TServerType);<br />
public<br />
{All output generated during the entire session up to now}<br />
property AllOutput: string read GetSessionLog;<br />
{True if connected to server}<br />
property Connected: boolean read FConnected;<br />
{Name or IP address of host to connect to}<br />
property HostName: string read FTargetHost write FTargetHost;<br />
{Port on host used for connection. If left as 0, it will be determined by protocol type (22 for SSH, 23 for Telnet}<br />
property Port: String read FTargetPort write FTargetPort;<br />
{Location of private key file.}<br />
property PrivateKeyFile: string read GetPrivateKeyFile write SetPrivateKeyFile;<br />
{Telnet login prompt}<br />
property TelnetLoginPrompt: string read FTelnetLoginPrompt write FTelnetLoginPrompt;<br />
{Telnet password prompt}<br />
property TelnetPasswordPrompt: string read FTelnetPasswordPrompt write FTelnetPasswordPrompt;<br />
{Username used when connecting}<br />
property UserName: string read FUserName write FUserName;<br />
{Password used when connecting. Used as passphrase if PrivateKey is used}<br />
property Password: string read FPassword write FPassword;<br />
{Should we talk Telnet or SSH to the server? Defaults to SSH.}<br />
property ProtocolType: TProtocolType read FProtocolType write ProtocolTypeChange;<br />
{Windows or Unix/Linux server? Has effect on line endings. Defaults to Unix. NOTE: untested}<br />
property Servertype: TServerType read FServerType write ServerTypeChange;<br />
{Initial message displayed on logon}<br />
property WelcomeMessage: string read FWelcomeMessage;<br />
{Connect/logon to server. Requires that all authentication, protocol and hostname/port options are correct<br />
Returns descriptive result. You can then use the Connected property.}<br />
function Connect: string;<br />
{If connected, logoff from server}<br />
procedure Disconnect;<br />
{Send command to server and receive result}<br />
function CommandResult(Command: string): string; //Send command and get results<br />
constructor Create;<br />
destructor Destroy; override;<br />
end;<br />
<br />
implementation<br />
<br />
<br />
{ TelnetSSHClient }<br />
procedure TTelnetSSHClient.SetPrivateKeyFile(value: string);<br />
begin<br />
Sock.SSL.PrivateKeyFile := value;<br />
end;<br />
<br />
function TTelnetSSHClient.GetPrivateKeyFile: string;<br />
begin<br />
Result := Sock.SSL.PrivateKeyFile;<br />
end;<br />
<br />
procedure TTelnetSSHClient.DetermineLineEnding;<br />
begin<br />
case FProtocolType of<br />
SSH:<br />
begin<br />
if FServerType = Unix then<br />
FServerLineEnding := #10 //Unix<br />
else<br />
FServerLineEnding := #13 + #10; //windows<br />
end;<br />
Telnet:<br />
begin<br />
if FServerType = Unix then<br />
FServerLineEnding := #10 //Unix<br />
else<br />
FServerLineEnding := #13 + #10; //windows<br />
end;<br />
else<br />
raise Exception.Create('Unknown protocol type');<br />
end;<br />
end;<br />
<br />
procedure Ttelnetsshclient.DeterminePort;<br />
begin<br />
if FTargetPort = '' then<br />
//Set default port for protocol<br />
begin<br />
case FProtocolType of<br />
Telnet: FTargetPort := '23';<br />
SSH: FTargetPort := '22';<br />
else<br />
raise Exception.Create('Unknown protocol type.');<br />
end;<br />
<br />
end;<br />
end;<br />
<br />
procedure TTelnetSSHClient.ServerTypeChange(Value: Tservertype);<br />
begin<br />
FServerType := Value;<br />
DetermineLineEnding;<br />
end;<br />
<br />
function TTelnetSSHClient.Connect: string;<br />
var<br />
Received: string;<br />
begin<br />
result:='Unknown error while connecting';<br />
FOutputPosition := 1; //First character in output stream<br />
FWelcomeMessage := '';<br />
//Just to make sure:<br />
DetermineLineEnding;<br />
DeterminePort;<br />
if FTargetPort='0' then<br />
begin<br />
result:='Port may not be 0.';<br />
exit; //jump out of function<br />
end;<br />
case FProtocolType of<br />
Telnet:<br />
begin<br />
try<br />
if Login then<br />
begin<br />
FConnected := True;<br />
result:='Connected to telnet server.';<br />
end<br />
else<br />
if Sock.LastError<>0 then raise Exception.Create(Sock.LastErrorDesc);<br />
except<br />
on E: Exception do<br />
begin<br />
FConnected:=false;<br />
result:='Error connecting to telnet server '+FTargetHost+':'+<br />
FTargetPort+' as user ' + FUserName +<br />
'. Technical details: '+E.Message;<br />
end;<br />
end;<br />
end;<br />
SSH:<br />
begin<br />
{$IFNDEF HAS_SSH_SUPPORT}<br />
raise Exception.Create(<br />
'SSH support has not been compiled into the telnetsshclient library.');<br />
{$ENDIF HAS_SSH_SUPPORT}<br />
try<br />
if (PrivateKeyFile <> '') and (FPassword <> '') then<br />
Sock.SSL.KeyPassword:=FPassword;<br />
if SSHLogin then<br />
begin<br />
FConnected := True;<br />
result:='Connected to SSH server.';<br />
end<br />
else<br />
begin<br />
if Sock.LastError<>0 then raise Exception.Create(Sock.LastErrorDesc);<br />
if Sock.SSL.LastError<0 then raise Exception.Create(Sock.SSL.LastErrorDesc);<br />
end;<br />
except<br />
on E: Exception do<br />
begin<br />
FConnected:=false;<br />
result:='Error connecting to SSH server '+FTargetHost+':'+<br />
FTargetPort+' as user ' + FUserName +<br />
'. Technical details: '+E.Message;<br />
end;<br />
end;<br />
end;<br />
else<br />
raise Exception.Create('Unknown protocol type');<br />
end;<br />
if FConnected = True then<br />
begin<br />
FWelcomeMessage := ReceiveData;<br />
if FProtocolType=Telnet then<br />
begin<br />
//Unfortunately, we'll have to extract login ourselves<br />
//Hope it applies to all server types.<br />
if (AnsiPos(AnsiLowerCase(FTelnetLoginPrompt),AnsiLowerCase(FWelcomeMessage))>0) then<br />
begin<br />
SendData(UserName);<br />
end;<br />
Received:=ReceiveData;<br />
if (AnsiPos(AnsiLowerCase(FTelnetPasswordPrompt),AnsiLowerCase(Received))>0) then<br />
begin<br />
SendData(Password);<br />
end;<br />
//Receive additional welcome message/message of the day<br />
FWelcomeMessage:=FWelcomeMessage+LineEnding+ReceiveData;<br />
end;<br />
end;<br />
end;<br />
<br />
procedure TTelnetSSHClient.Disconnect;<br />
begin<br />
Logout;<br />
FConnected := False;<br />
end;<br />
<br />
function TTelnetSSHClient.ReceiveData: string;<br />
begin<br />
Result := '';<br />
while Sock.CanRead(1000) or (Sock.WaitingData > 0) do<br />
begin<br />
Sock.RecvPacket(1000);<br />
Result := Result + Copy(SessionLog, FOutputPosition,<br />
Length(SessionLog));<br />
FOutputPosition := Length(SessionLog) + 1;<br />
end;<br />
end;<br />
<br />
procedure Ttelnetsshclient.SendData(Data: String);<br />
begin<br />
Data := Data + FServerLineEnding; //Could be linux, could be Windows<br />
Send(Data);<br />
end;<br />
<br />
function TTelnetSSHClient.GetSessionLog: string;<br />
begin<br />
// Gets complete output up to now<br />
Result := SessionLog;<br />
end;<br />
<br />
procedure TTelnetSSHClient.ProtocolTypeChange(Value: Tprotocoltype);<br />
begin<br />
FProtocolType := Value;<br />
//Auto-determine port and line ending, if necessary<br />
DeterminePort;<br />
DetermineLineEnding;<br />
end;<br />
<br />
function TTelnetSSHClient.CommandResult(Command: string): string;<br />
begin<br />
Result := '';<br />
if FConnected then<br />
begin<br />
SendData(Command);<br />
Result := ReceiveData; //gets too much<br />
end<br />
else<br />
begin<br />
//raise exception<br />
Result := '';<br />
raise Exception.Create('Can only run command when connected');<br />
end;<br />
end;<br />
<br />
constructor TTelnetSSHClient.Create;<br />
begin<br />
inherited;<br />
FConnected := False;<br />
FProtocolType := SSH; //Could be telnet, too<br />
FServerType := Unix; //Probably a safe default.<br />
FTelnetLoginPrompt := 'login:';<br />
FTelnetPasswordPrompt := 'password:';<br />
DetermineLineEnding;<br />
DeterminePort;<br />
end;<br />
<br />
destructor TTelnetSSHClient.Destroy;<br />
begin<br />
if FConnected then<br />
Disconnect;<br />
inherited Destroy;<br />
end;<br />
<br />
end.<br />
</syntaxhighlight><br />
<br />
== Example program ==<br />
To use the class we just made, you can use this example application, sshtest.lpr. Note that it needs to be compiled by Lazarus as it needs the LCL components to work with Synapse:<br />
<syntaxhighlight><br />
program sshtest;<br />
<br />
{Test program for telnetsshclient<br />
<br />
Written by Reinier Olislagers 2011.<br />
Modified for libssh2 by Alexey Suhinin 2012.<br />
<br />
License of code:<br />
* MIT<br />
* LGPLv2 or later (with FreePascal static linking exception)<br />
* GPLv2 or later<br />
according to your choice.<br />
Free use allowed but please don't sue or blame me.<br />
<br />
Uses other libraries/components; different licenses may apply that also can influence the combined/compiled work.<br />
<br />
Run: sshtest <serverIPorhostname> [PrivateKeyFile]<br />
}<br />
{$mode objfpc}{$H+}<br />
{$APPTYPE CONSOLE}<br />
<br />
uses<br />
telnetsshclient;<br />
var<br />
comm: TTelnetSSHClient;<br />
Command: string;<br />
begin<br />
writeln('Starting.');<br />
comm:=TTelnetSSHClient.Create;<br />
comm.HostName:= ParamStr(1); //First argument on command line<br />
if comm.HostName='' then<br />
begin<br />
writeln('Please specify hostname on command line.');<br />
halt(1);<br />
end;<br />
<br />
comm.PrivateKeyFile := ParamStr(2);<br />
<br />
comm.TargetPort:='0'; //auto determine based on protocoltype<br />
comm.UserName:='root'; //change to your situation<br />
comm.Password:='password'; //change to your situation<br />
comm.ProtocolType:=SSH; //Telnet or SSH<br />
writeln(comm.Connect); //Show result of connection<br />
if comm.Connected then<br />
begin<br />
writeln('Server: ' + comm.HostName + ':'+comm.TargetPort+', user: '+comm.UserName);<br />
writeln('Welcome message:');<br />
writeln(comm.WelcomeMessage);<br />
Command:='ls -al';<br />
writeln('*** Sending ' + Command);<br />
writeln('*** Begin result****');<br />
writeln(comm.CommandResult(Command));<br />
writeln('*** End result****');<br />
writeln('');<br />
writeln('');<br />
Command:='df -h';<br />
writeln('*** Sending ' + Command);<br />
writeln('*** Begin result****');<br />
writeln(comm.CommandResult(Command));<br />
writeln('*** End result****');<br />
writeln('');<br />
writeln('');<br />
writeln('All output:');<br />
writeln('*** Begin result****');<br />
writeln(comm.AllOutput);<br />
writeln('*** End result****');<br />
comm.Disconnect;<br />
end<br />
else<br />
begin<br />
writeln('Connection to ' +<br />
comm.HostName + ':' +<br />
comm.TargetPort + ' failed.');<br />
end;<br />
comm.Free;<br />
end.<br />
</syntaxhighlight><br />
<br />
=OAuth v1/Twitter/Plurk integration=<br />
An OAuth v1 library written in FPC that uses Synapse (and is ready for other network libaries like lnet) is available [https://bitbucket.org/reiniero/fpctwit here].<br />
<br />
FPCTwit also contains FPC twitter and plurk example client programs and a Lazarus twitter client.<br />
<br />
<br />
= Other Web and Networking Articles =<br />
<br />
* [[Portal:Web Development|Web Development Portal]]<br />
* [[Networking]]<br />
* [[Networking libraries]] - comparison of various networking libraries<br />
* [http://brookframework.org Brook Framework] - The perfect Free Pascal framework for your web applications. It's pure Pascal. You don't need to leave your preferred programming language.<br />
* [[Sockets]] - TCP/IP Sockets components<br />
* [[fcl-net]] - Networking library supplied with FPC<br />
* [[lNet]] - Lightweight Networking Components<br />
* [[Synapse]] - Serial port and synchronous TCP/IP Library<br />
* [[XML Tutorial]] - XML is often utilized on network communications<br />
* [[FPC and Apache Modules]]<br />
* [[fcl-web]] - Also known as fpWeb, this is a library to develop web applications which can be deployed as cgi, fastcgi or apache modules.<br />
* [[Secure programming | Secure Programming]]<br />
* [[Internet Tools]] - A wrapper around Synapse/wininet/Android's httpcomponents simplifying https and redirections, and a XPath/XQuery/CSS Selector/JSONiq engine to process the downloaded pages<br />
<br />
<br />
=See also=<br />
<br />
* [[Download from SourceForge]] Example that uses Synapse to download from an HTTP server that redirects.<br />
<br />
=External links=<br />
<br />
* [http://www.ararat.cz/synapse/ Official site]<br />
* [http://synapse.ararat.cz/doc/help/ Official documentation]<br />
* [http://lazarus.freepascal.org/index.php/topic,16032.msg87066.html#msg87066 User malcome created a fork in order to more quickly improve synapse]; this fork is located at [http://code.google.com/p/synapse4lazarus/ Google code site for Synapse4Lazarus]<br />
<br />
[[Category:Networking]]<br />
[[category:Example programs]]<br />
[[Category:Lazarus]]</div>Rvkhttps://wiki.freepascal.org/index.php?title=User:Rvk&diff=103830User:Rvk2016-09-02T13:33:01Z<p>Rvk: Blanked the page</p>
<hr />
<div></div>Rvkhttps://wiki.freepascal.org/index.php?title=User:Rvk&diff=103827User:Rvk2016-09-02T13:23:51Z<p>Rvk: </p>
<hr />
<div>addresses</div>Rvkhttps://wiki.freepascal.org/index.php?title=User:Rvk&diff=103826User:Rvk2016-09-02T13:23:28Z<p>Rvk: </p>
<hr />
<div>scraps pasted from the Web, etc.</div>Rvkhttps://wiki.freepascal.org/index.php?title=User:Rvk&diff=103825User:Rvk2016-09-02T13:23:09Z<p>Rvk: </p>
<hr />
<div>notes, emails, articles</div>Rvkhttps://wiki.freepascal.org/index.php?title=User:Rvk&diff=103824User:Rvk2016-09-02T13:22:54Z<p>Rvk: Blanked the page</p>
<hr />
<div></div>Rvkhttps://wiki.freepascal.org/index.php?title=User:Rvk&diff=103823User:Rvk2016-09-02T13:22:24Z<p>Rvk: </p>
<hr />
<div>== TreePad Lite for Linux ==<br />
TreePad Lite can help you manage, store, search, edit, organize and browse any type of textual data, such as</div>Rvkhttps://wiki.freepascal.org/index.php?title=User:Rvk&diff=103822User:Rvk2016-09-02T13:21:32Z<p>Rvk: Created page with "You can enter western as well as non-western characters into the article, tree-node titles and search toolbars. You can e.g. mix western, Chinese, Japanese, Russian, Arabic, G..."</p>
<hr />
<div>You can enter western as well as non-western characters into the article, tree-node titles and search toolbars. You can e.g. mix western, Chinese, Japanese, Russian, Arabic, Greek, Hebrew and even Phonetic characters - assuming the appropriate fonts are installed on your system.</div>Rvkhttps://wiki.freepascal.org/index.php?title=TFBAdmin&diff=99867TFBAdmin2016-02-23T18:25:00Z<p>Rvk: /* Example */</p>
<hr />
<div>== Overview==<br />
TFBAdmin in the FBAdmin unit is used for the administration of the database. It provides the following functionality:<br />
* add, modify or delete database users<br />
* backup and restore databases using single or multiple (split) files<br />
* get general database information <br />
* get the database log file listing important database events and errors<br />
<br />
There is also a Lazarus component and demo that allows use of the FPC TFBAdmin component.<br />
<br />
[[Image:sqldbcomponents.png]]<br />
<br />
== Example ==<br />
This shows how to create a multi file backup of a database on a linux server; 3 backup files, size limited to 600MB; backup progress shown in a TMemo:<br />
<syntaxhighlight><br />
procedure TForm1.logadm(Sender: TObject; msg: string; IBAdminAction: string);<br />
begin<br />
Memo1.Lines.add(IBAdminAction+' : '+msg);<br />
end;<br />
<br />
procedure TForm1.backup;<br />
var<br />
Admin:TFBAdmin;<br />
sl:TStringList;<br />
begin<br />
Admin:=TFBAdmin.Create(self);<br />
sl:=TStringList.create;<br />
try<br />
Admin.UseExceptions:=true;<br />
Admin.Host:='192.168.2.98';<br />
Admin.Protocol:=IBSPTCPIP;<br />
Admin.User:='sysdba';<br />
Admin.Password:='masterkey';<br />
Admin.Port:= 3050; //change if not using the default port<br />
Admin.Connect;<br />
Admin.OnOutput:=@logadm;<br />
sl.Add('/home/firebird/test.bak1');<br />
sl.Add('/home/firebird/test.bak2');<br />
sl.Add('/home/firebird/test.bak3');<br />
Admin.BackupMultiFile('/home/firebird/test.fdb',sl,600000000,[IBBkpVerbose]);<br />
finally<br />
sl.Destroy;<br />
Admin.Destroy; //disconnects automatically<br />
end;<br />
end;<br />
</syntaxhighlight><br />
<br />
A demo program is also available in the examples directory of the fcl-db package.<br />
<br />
The following example shows how to backup to and restore from a single file on a Windows-server:<br />
<syntaxhighlight><br />
uses FBAdmin;<br />
<br />
procedure TForm1.logadm(Sender: TObject; msg: string; IBAdminAction: string);<br />
begin<br />
Memo1.Lines.add(IBAdminAction + ' : ' + msg);<br />
end;<br />
<br />
procedure Backup(Database, Backupfile: string);<br />
var<br />
Admin: TFBAdmin;<br />
begin<br />
Admin := TFBAdmin.Create(nil);<br />
try<br />
Admin.UseExceptions := True;<br />
Admin.Host := '192.168.1.66';<br />
Admin.Protocol := IBSPTCPIP;<br />
Admin.User := 'SYSDBA';<br />
Admin.Password := 'masterkey';<br />
Admin.Port := 3050; //change if not using the default port<br />
Admin.Connect;<br />
Admin.OnOutput := @Form1.logadm;<br />
Admin.Backup(Database, Backupfile, [IBBkpVerbose]);<br />
finally<br />
Admin.Free; //disconnects automatically<br />
end;<br />
end;<br />
<br />
procedure Restore(Database, Backupfile: string);<br />
var<br />
Admin: TFBAdmin;<br />
begin<br />
Admin := TFBAdmin.Create(nil);<br />
try<br />
Admin.UseExceptions := True;<br />
Admin.Host := '192.168.1.66';<br />
Admin.Protocol := IBSPTCPIP;<br />
Admin.User := 'SYSDBA';<br />
Admin.Password := 'masterkey';<br />
Admin.Port := 3050; //change if not using the default port<br />
Admin.Connect;<br />
Admin.OnOutput := @Form1.logadm;<br />
Admin.Restore(Database, Backupfile, [IBResVerbose, IBResReplace]);<br />
finally<br />
Admin.Free; //disconnects automatically<br />
end;<br />
end;<br />
<br />
procedure TForm1.btBackupClick(Sender: TObject);<br />
begin<br />
Backup('c:\data\demo.fdb', 'c:\temp\demo.fbk');<br />
end;<br />
<br />
procedure TForm1.btRestoreClick(Sender: TObject);<br />
begin<br />
Restore('c:\data\demo_restored.fdb', 'c:\temp\demo.fbk');<br />
end;<br />
</syntaxhighlight><br />
<br />
== See also ==<br />
* [[Firebird]] Using Firebird with FPC/Lazarus sqldb.<br />
<br />
{{LCL Components Footer |TIBConnection|TFBEventMonitor}}<br />
{{LCL Components}}<br />
<br />
[[Category:Databases]]<br />
[[Category:Tutorials]]<br />
[[Category:FPC]]<br />
[[Category:LCL]]<br />
[[Category:Components]]</div>Rvk