Archiv des Autors: admin

Excel Split Filename from Full Path

Veröffentlicht am von

Sub SplitFilenamefromFullPath()
'
' SplitFilenamefromFullPath Macro
' Macro recorded 19.05.2011 by Frick
'
Dim a() As String
'MsgBox "The selection object type is " & TypeName(Selection)
If TypeName(Selection) = "Range" Then
' only do if it is a range
For Each rngZelle In Selection
' MsgBox rngZelle.Value
' MsgBox TypeName(rngZelle)
a = Split(rngZelle.Value, "/")
If UBound(a) > 0 Then
rngZelle.Value = a(UBound(a))
End If
' MsgBox rngZelle.Value
Next
End If
End Sub

Veröffentlicht unter Allgemein

Excel Datenquellen

Veröffentlicht am von

Verbindungszeichenfolge

DSN=Excel Files;DBQ=D:\olfri\Excel\100309_Adressen.xls;DefaultDir=D:\olfri\Excel;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;

Veröffentlicht unter Allgemein

Update Excel Cells with color

Veröffentlicht am von


Sub Update_Row_Colors()

Dim LRow As Integer
Dim LCell As String
Dim LColorCells As String
'Start at row 7
LRow = 7

'Update row colors for the first 2000 rows
While LRow < 2000
LCell = "C" & LRow
'Color will changed in columns A to K
LColorCells = "A" & LRow & ":" & "K" & LRow

Select Case Left(Range(LCell).Value, 6)

'Set row color to light blue
Case "007007"
Range(LColorCells).Interior.ColorIndex = 34
Range(LColorCells).Interior.Pattern = xlSolid

'Set row color to light green
Case "030087"
Rows(LRow & ":" & LRow).Select
Range(LColorCells).Interior.ColorIndex = 35
Range(LColorCells).Interior.Pattern = xlSolid

'Set row color to light yellow
Case "063599"
Rows(LRow & ":" & LRow).Select
Range(LColorCells).Interior.ColorIndex = 19
Range(LColorCells).Interior.Pattern = xlSolid

'Default all other rows to no color
Case Else
Rows(LRow & ":" & LRow).Select
Range(LColorCells).Interior.ColorIndex = xlNone

End Select

LRow = LRow + 1
Wend

Range("A1").Select

End Sub

Veröffentlicht unter Allgemein

Ethernet Shield am AT Mega

Veröffentlicht am von

-#define ENC28J60_CONTROL_CS 10
-#define SPI_MOSI 11
-#define SPI_MISO 12
-#define SPI_SCK 13
+#if defined(__AVR_ATmega1280__) || defined(__AVR_ATmega2560__)
+ #define ENC28J60_CONTROL_CS 53
+ #define SPI_MOSI 51
+ #define SPI_MISO 50
+ #define SPI_SCK 52
+#else
+ #define ENC28J60_CONTROL_CS 10
+ #define SPI_MOSI 11
+ #define SPI_MISO 12
+ #define SPI_SCK 13
+#endif

Veröffentlicht unter Allgemein

PHP Simple DOM Example

Veröffentlicht am von

createElement('cds');
$dom->appendChild($root);

mysql_connect("localhost","root","");
mysql_select_db("cdcol");

$result=mysql_query("SELECT id,titel,interpret,jahr FROM cds ORDER BY interpret;");

while( $row=mysql_fetch_array($result) )
{
$cd = $dom->createElement('cd');
$cd->setAttribute('id', $row['id']);

$titel = $dom->createElement('titel');
$titel->appendChild($dom->createTextNode($row['titel']));
$cd->appendChild($titel);

$interpret = $dom->createElement('interpret');
$interpret->appendChild($dom->createTextNode($row['interpret']));
$cd->appendChild($interpret);

$jahr = $dom->createElement('jahr');
$jahr->appendChild($dom->createTextNode($row['jahr']));
$cd->appendChild($jahr);

$root->appendChild($cd);
}

header("Content-Type: text/xml;");
$xml="


";
echo $xml;
print $dom->saveXML();
echo "";
?>

Veröffentlicht unter Allgemein

Delphi Webserver with Indy

Veröffentlicht am von

{
implements a very basic webserver with Systray icon and menu using Indy components
(C) 2010 Oliver Frick
}

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellAPI, Menus, ExtCtrls, StdCtrls, FileCtrl, IdBaseComponent,
IdComponent, IdTCPServer, IdCustomHTTPServer, IdHTTPServer,
IdAntiFreezeBase, IdAntiFreeze, IdGlobal, StrUtils, IdThreadMgr,
IdThreadMgrDefault;

const
WM_ICONTRAY = WM_USER + 1; // User-defined message

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
mnuExit: TMenuItem;
GroupBox1: TGroupBox;
Label2: TLabel;
Button2: TButton;
Label1: TLabel;
IdHTTPServer1: TIdHTTPServer;
IdAntiFreeze1: TIdAntiFreeze;
Memo1: TMemo;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mnuExitClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure IdHTTPServer1CommandGet(AThread: TIdPeerThread;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure Button1Click(Sender: TObject);
procedure Logfile(Text: String);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
function GetMIMEType(sFile: TFileName): String;
procedure Icontray(var Msg: TMessage); message WM_ICONTRAY;
public
MIMEMap: TIdMIMETable;
{ Public declarations }
end;

var
Form1: TForm1;
NotifyIconData : TNotifyIconData;
FDirectory: string;
LogfileMaxLines: Word;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
with NotifyIconData do begin
hIcon := Application.Icon.Handle; // use application icon
StrPCopy(szTip, 'SimpleHTTP is running');
Wnd := Handle;
uCallbackMessage := WM_ICONTRAY;
uID := 1;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
cbSize := sizeof(TNotifyIconData);
end;
Shell_NotifyIcon(NIM_ADD, @NotifyIconData);

MIMEMap := TIdMIMETable.Create(true);
{get current dir and set Label}
GetDir(0, FDirectory);
Label2.Caption := FDirectory;
LogfileMaxLines := 500;
end;

procedure TForm1.Icontray(var Msg: TMessage);
var
CursorPos : TPoint;
begin
if Msg.lParam = WM_RBUTTONDOWN then begin
GetCursorPos(CursorPos);
SetForegroundWindow(Handle); // suggested by Berend Radstaat
PopupMenu1.Popup(CursorPos.x, CursorPos.y);
PostMessage(Handle, WM_NULL, 0, 0); // suggested by Berend Radstaat
end else
if Msg.LParam = WM_LBUTTONDBLCLK then begin
Show;
// Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
end else
inherited;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Hide;
// Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
end;

procedure TForm1.mnuExitClick(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
Application.ProcessMessages;
Application.Terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
const
SELDIRHELP = 1000;
var
dir: String;
begin
if SelectDirectory(
dir,
[sdAllowCreate,
sdPerformCreate,
sdPrompt],
SELDIRHELP
) then
{show dir in Label}
Label2.Caption := dir;
end;

procedure TForm1.IdHTTPServer1CommandGet(AThread: TIdPeerThread;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
LFilename: string;
LPathname: string;
FileExt, CType: string;
begin
LFilename := ARequestInfo.Document;
if LFilename = '/' then begin
LFilename := '/index.html';
end;
LPathname := Label2.Caption + LFilename;
if FileExists(LPathname) then begin
AResponseInfo.ContentType := GetMIMEType(LPathname);
AResponseInfo.ContentLength := FileSizeByName(LPathname);
AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);
end else begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := 'The requested URL ' + ARequestInfo.Document
+ ' was not found on this server.';
end;
Logfile( TimeToStr(Time) + ' ' + ARequestInfo.RawHTTPCommand );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Status : string;
begin
If IdHTTPServer1.Active then begin
IdHTTPServer1.Active := False;
Button1.Caption := 'Start';
Status := 'SimpleHTTP is stopped';
end else begin
IdHTTPServer1.Active := True;
Button1.Caption := 'Stop';
Status := 'SimpleHTTP is running';
end;
StrPCopy(NotifyIconData.szTip, Status);
Shell_NotifyIcon(NIM_MODIFY, @NotifyIconData);
end;

procedure TForm1.Logfile(Text: String);
begin
If Memo1.Lines.Count > LogFileMaxLines then Memo1.Clear;
Memo1.Lines.Append( Text );
end;

function TForm1.GetMIMEType(sFile: TFileName): String;
begin
result := MIMEMap.GetFileMIMEType(sFile);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
MIMEMap.Free;
end;

end.

Veröffentlicht unter Allgemein

DLL erstellen in Delphi >= 7

Veröffentlicht am von

Delphi 7
——–

DLL erstellen:

Datei -> Neu -> DLL

resp. in bestehendem Projekt „Project“ -> „View Source“

program durch library ersetzen,
dies weist den Compiler an, eine DLL zu erstellen.

Quelltext:

library DemoDeskBar;

uses
ComServ,
DemoDeskBar_TLB in 'DemoDeskBar_TLB.pas',
unitDemoDeskBand in 'unitDemoDeskBand.pas',
formVisibleBand in 'formVisibleBand.pas' {frmVisibleBand};

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.

compilieren

regsvr32 DemoDeskBar.dll

testen

regsvr32 /u DemoDeskBar.dll

Veröffentlicht unter Allgemein

Order Cancellator PHP

Veröffentlicht am von




Test 2



50
AND order_id = v_order_id;

UPDATE order_milestones SET status_id = 80 WHERE status_id <> 50
AND order_id = v_order_id;

UPDATE order_work_queue SET status = 80 WHERE status <> 50
AND order_id = v_order_id;

UPDATE customer_order SET order_status = 5 WHERE order_status in ( 1, 2, 3 )
AND order_id = v_order_id;

UPDATE order_lookup SET order_status = 5 WHERE order_status in ( 1, 2, 3 )
AND order_id = v_order_id;

DELETE FROM order_dependency WHERE order_id = v_order_id
or dependent_upon_order_id = v_order_id;

delete from invd_order_dep c
where c.order_id in ( v_order_id );

delete from INVD_CHANGE c
where c.order_id in ( v_order_id );

delete from PEN_XFER_HISTORY px
where px.order_id in ( v_order_id );

delete from PEN_SWAP_HISTORY ps
where ps.order_id in ( v_order_id );
COMMIT;
END;
");
OCIExecute($stmt);
if ( $stmt ) echo "Auftrag $order_id abgebrochen.";
}
elseif ( $_REQUEST['action'] == 'check' && isset ( $_SESSION['arbor_user'] ) && isset ( $_SESSION['arbor_passwd'] ) && isset ( $_REQUEST['account_no'] ) )
{
$conn=OCILogon($_SESSION['arbor_user'], $_SESSION['arbor_passwd'], $db);
$sql=
"
SELECT *
FROM CUSTOMER_ORDER@aom WHERE MASTER_ACCOUNT_NO = $_REQUEST[account_no] AND ORDER_STATUS NOT IN ( 4 , 5 )
";
$stmt=OCIParse($conn, $sql);
OCIExecute($stmt);
$nrows = OCIFetchStatement($stmt,$results);
if ( $nrows > 0 ) {
print "

\n";
print "\n";

$external_id = $results['ORDER_ID'][0] ;

while ( list( $key, $val ) = each( $results ) ) {
print "

\n";
}
print "\n";

for ( $i = 0; $i < $nrows; $i++ ) { reset($results); print "

\n";
while ( $column = each($results) ) {
$data = $column['value'];
print "\n";
}
print "\n";
}
print "
$key
$data[$i]
\n";

?>





\n";
}
print "$nrows Record(s) Selected
\n";

OCIFreeStatement($stmt);
OCILogoff($conn);
?>

Arbor Login:

Passwort:

Account No.:


Veröffentlicht unter Allgemein

Show BOINC progress in percent

Veröffentlicht am von

#!/bin/bash
# ausgeben wieviel prozent der aktuellen workunit unter boinc abgelaufen ist
# boinc muss laufen
echo $(./boinc_cmd --get_state | grep fraction | sed -e "s/fraction done://"| sed -e "s/ //" | grep -v 0.000000 | sort -n -r | grep . | head -n 2 | sed -e "s/0.//" -e "s/\([0-9]\)\([0-9]\)\([0-9]\)\([0-9]\)\([0-9]\)\([0-9]\)/\1\2,\3\4%/")

# unter OpenBSD, head -n 2 anstelle von grep -m benutzen
echo $(./boinc_cmd --get_state | grep fraction | sed -e "s/fraction done://"| sed -e "s/ //" | grep -v 0.000000 | sort -n -r | grep . | head -n 2 | sed -e "s/0.//" -e "s/\([0-9]\)\([0-9]\)\([0-9]\)\([0-9]\)\([0-9]\)\([0-9]\)/\1\2.\3\4%/")

Veröffentlicht unter Allgemein

Move folders into project/environment subfolders

Veröffentlicht am von

#!/bin/bash
# move folders into subfolders based on a value in a textfile inside the source folders
for i in $(find . -maxdepth 1 -type d -name "R??.*")
do
echo $i
if test -f $i/clarify.env ; then
j=$(grep -o "^db_name=.*" $i/clarify.env | cut -d "=" -f 2)
test ! -d _$j && mkdir _$j
if test $j -a -d _$j ; then
echo moving $i into _$j
mv -i $i _$j
fi
fi
done

Veröffentlicht unter Allgemein